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SECTION I 
INTRODUCTION 


Volume II documents the software developed for the sol Idi f Tcatlon model. This 
volume provides a link between the calculations described in Volume I and the 
FORTRAN code, primarily in the form of global flow diagrams and data structures. 
Considerable effort was expended in the design phase of the task to provide a 
code that is well structured, easily readable, and essentially self-documenting. 
Hence the minutia of the code need not be repeated here: indeed, such redundancy 

is best omitted because It can only provide an opportunity for discrepancy. 

A complete listing of the solidification code is in Appendix A. 

It is assumed that the reader of this volume is familiar with the calculation 
described by Volume I, with the program operating characteristics as described 
by Volume III, and with the FORTRAN language. 
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SECTION 2 




FLOW DIAGRAMS 

1 

2.1 

GLOBAL FLOW DIAGRAM 





INTERACTIVE OR BATCH 
INPUT 
(1 CASE) 




BATCH 

AND NO NEW 
^ CASE? 


HQ- 



OUTPUT 

SECTION 


INTERACTIVE OUTPUT 
TABLES 
GRAPHS 

BATCH OUTPUT 


TABLES 


'^INTERACT IV 
USER SELECTED 
QUIT? 



... 












2.2 CALCULATION SECTION 


CONTROLLER: 


Main 








2.3 INPUT SECTION 


INITIALIZE TERMINAL 
CONTROL SYSTEM 
(lACTl) 


INITIALIZE INPUT ARRAYS 
CINCON) 


CONTROLLER; 
CALLED FROM 


BATCH? 


READ CASE TITLE 
( BATCH I ) 


PUT ID PAGE ON SCREEN 
AND GET CASE TITLE 
(lACTl) 


yes , 

END OF FILE7>— KsTOP 


GET ALLOY 
(lACTl) 


READ AND PRINT ALLOY 
(BATCH I ) 


ACCESS ALLOY DATA BASE 
(ADB) 


GET REMAINING PARAMETERS 
(lACTl) 


ACCESS ALLOY DATA BASE 
(ADB) 


READ AND PRINT REMAINING PARAMETERS 
(BATCH I ) 


INPUT ERRORS 
IN THIS 
\ CASE?^ 


EXTRACT PARAMETER VALUES 
FROM INPUT ARRAYS 
(INCON) 


CONVERT TO CGS UNITS 
(INCON) 


RETURN 




















SECTION 3 
MODULES 


3.1 ALPHABETICAL LIST OF MODEL I SUBROUTINES 

The list below contains only the niodules that were written specifically for the 
solidification model. Off-the-shelf routines used by the model are listed in 
Sections 3.2 and 3.3. The purpose of each routine is described briefly below; 
details of the programming, including calling sequence descriptions, are in 
the program convr.ants. 


NAME 

SECTION 

FUNCTION 

ADB 

Input 

Retrieve phase diagram, densities and viscosity from 
alloy data base. 

AD ISP 

Output 

Displays any array on the screen or in printed form. 

AXES 

Output 

Draws and labels axes on all plots. 

BATCH 1 

Input 

Controls batch mode card input. 

EST 

Calculation 

Calculates initial estimated solution (see Vol 1, 4.3). 

FRECKL 

Calculation 

Sets flag if freckling condition detected (see Vol 1, 4.10). 

GPBLK 

Output 

Puts parameter block on plot. 

GPHCON 

Output 

Controls interactive graphics. 

HPROFS 

Output 

Controls horizontal profile plots. 

lACTI 

Input 

Controls interactive input. 

INCON 

Input 

Controls input section. 

INIT 

Calculation 

Initialization routine. 

LFRAC 

Calculation 

Calculates gj^ (see Vol 1, 4.7). 

MACS EG 

Calculation 

Calculates C^ (see Vol 1, 4.9). 

MSG 

Calculation 

Puts any brief message on terminal screen. 

OUTCON 

Output 

Controls output section. 

PERM 

Calculation 

Calculates permeability according to equation (1.3.6.10). 

PSETUP 

Calculation 

Calculates X, and B and sets up boundary 
conditions (see Vol 1, 4.4 and 4.5). 

PSOLVE 

Calculation 

Solves the pressure equation (see Vol 1, 4.5) 
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NAME 

SECTION 

FUNCTION 

SCALE 

Output 

Calculates neat scales for plots. 

SETHOL 

Input 

Sets up long hollerith arrays. 

SETPLT 

Output 

Initializes all plots and puts on labels. 

SS 1 CON 

Calculation 

Controls convergence to steady-state solution 
(see Vol 1, 4.8). 

VECPLT 

Output 

Controls plots of vector fields. 

VLCTY 

Calculation 

Calculates velocity (see Vol 1, 4.6). 

VPROFS 

Output 

Controls vertical profile plots. 

WAIT 

Output 

Waits for the operator to enter a P. 

3.2 PRIME 

SYSTEM ROUTINES 


The following routines from the Prime system library are called by the 
solidification model. Documentation is available in the Prime Corporation 
Document, "FORTRAN Programmer's Guide", PDR 3057. 


NAME 

CALLED 


FUNCTION 

DATE$A 

BATCH 1, 

lACTI 

Returns 

current calendar date. 

SEARCH 

ADB 


Used to 
FORTRAN 

rewind data base file because Prime 
REWIND does not work. 

TIME$A 

BATCH 1 , 

lACTI 

Returns 

current wall-clock time. 


3.3 TEKTRONIX ROUTINES 

The following routines from the Tektronix software libraries control the 
terminal and provide basic plot capability. They are documented in the 
Tecktronix, Inc. reports "Plot-10 Terminal Control System User's Manual", 
Document No. 062- li»7^*-00 and "Plot-10 Advanced Graphing II User's Manual", 
Document No. 062-1530-00. 

NAME SYSTEM FUNCTION 

ANMODE TCS Switches to alphanumeric mode for use of FORTRAN 1/0. 

AOUTST TCS Outputs alphanumeric data through Terminal 

Control System. 
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NAME 

SYSTEM 

FUNCTION 

BELL 

TCS 

Rings terminal betiv 

BINin 

AGS- 1 1 

initialize plot cornnon area. 

CHECK 

AGS- 1 1 

Sets parameters in plot common area. 

CHRSIZ 

TCS 

Sets character size. 

CPLOT 

AGS- 1 1 

Plots a curve (Must follow call to DSPLAY). 

CSIZE 

TCS 

Returns dimensions of a character In raster units. 

DLIMX, 

DLIMY 

AGS- 1 1 

Set the data values corresponding to the plot 
window: they determine the scale of the plot. 

DRWABS 

TCS 

Generates a line from the current beam position 
to the raster coordinate given in the parameter 
list. 

DSHABS 

TCS 

The same function as DRWABS, except the line is 
dashed. 

DSPLAY 

AGS- 1 1 

Displays axes and curve on screen. 

DWINDO 

TCS 

Sets correspondence between user coordinates 
and virtual window. 

GRID 

AGS- 1 J 

Draws axes. 

INITT 

TCS 

Initializes the Terminal Control System, 

LINE 

AGS- 1 1 

Sets a dashed line pattern for use by CPLOT. 

LINHGT, 

LINWDT 

TCS 

Determine the height or length of a block of text, 

MOVABS 

TCS 

Moves the beam to a given point. 

NEWPAG 

TCS 

Clears the screen. 

NPTS 

AGS- 1 1 

Tells CPLOT how many points are on curve. 

SLIMX, 

SLIMY 

AGS- 1 1 

Sets the virtual window. 

TERM 

TCS 

Identifies terminal hardware type to Terminal 
Control System. 

XFRM, 

YFRM 

AGS- 1 1 

Set form of major tic marks. 
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NAME 

SYSTEM 

FUNCTION 

XLEN, 

YLEN 

AGS- II 

Set 

length of major tic marks. 

XLOC, 

XLOCTP 

AGS- t 1 

Set 

locations of the x-axes. 

XMTCS, 

AGS- 1 1 

Set 

the number of minor tic mark intervals. 

YMTCS 


\ 

• 

XNEAT, 

YNEAT 

AGS- 1 i 

Set 

the "neat" tic mark condition. 

XTICS, 

YTICS 

AGS- 1 1 

Set 

the number of major tic mark intervals. 

XZERO, 

YZERO 

AGS- 1 1 

Set 

the zero-suppression flag for tic mark values. 

YLOC, 

YLOCRT 

AGS- 11 

Set 

locations of the y-axes. 


SECTION k 

KEY PROGRAM SYMBOLS 

A description of all common block items is at the end of subroutine I NIT. 


PROGRAM 

SYMBOL 

COMMON 

BLOCK 

DEFINITION 

(See Volume 1, Section 2) 

A 

/PRSSEQ/ 

A 

ALNAM 

/ALLOY/ 

Element 1 is the hollerith solvent name 



Element 2 is the hollerith solute name. 

AVCS 

/PHYS/ 


B 

/PRSSEQ/ 

B 

CL 

/PHYS/ 

'l 

CL0 

/ALLOY/ 

c 

O 

DCLDT 

/ALLOY/ 

dC|^/dT 

DCLDTM 

/PHYS/ 

SC|_/3t 

DGLDTM 

/PHYS/ 

39^/3 t 

DRHDC 

/ALLOY/ 

dPL/dC^ 

DRHDTM 

/PHYS/ 

3p|_/3t 

DTDTM 

/PROCSS/ - 

3T/3t = e 

DTDX 

/PROCSS/ 

3T/3x = G 

DX 

/MESH/ 

Ax 

DXM 

/PROCSS/ 

V^E 

DY 

/MESH/ 

Ay 

DYM 

/PROCSS/ 

L 

GAMMA 

/PMBLTY/ 

Y' 

GL 

/PHYS/ 

9l 

GRAV 

/PROCSS/ 

9 

KK 

/PHYS/ 

K 

MAXSSI 

/SSI/ 

M 

•^ssi 

MAXSOR 

/SOR/ 

M 

"sOR 




PROGRAM 

SYMBOL 

COMMON 

BLOCK 

DEFINI 
(See V 

Ml 

/MESH/ 


NJ 

/MESH/ 

"j 

P 

/PHYS/ 

P 

RHL 

/PHYS/ 

Pl 

PsMLE 

/ALLOY/ 

Ple 

RHS 

/ALLOY/ 

Ps 

RHSE 

/ALLOY/ 

PSE 

T 

/PHYS/ 

T 

TE 

/ALLOY/ 


no 

/ALLOY/ 


V 

/PHYS/ 

V 

vise 

/ALLOY/ 

y 

X, XX 

/MESH/ 

X, (x-: 

Y, YY 

/MESH/ 

y, y/L 


'L 
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SECTION 5 

PROGRAM CONFIGURATION ON THE PRIME 


The procedures described in this section are used to maintain the program on 
the Prime 400 system. 


5.1 COMPILATION 


If the FORTRAN source code Is stored in a file named MPSI.PGM, then it can be 
compiled by entering the coninand 


FTN MPSI.PGM 2/500 


5.2 LOADING 


The Prime utility for loading and running segmented programs in SEG. It can 
be used to build a run file as follows: 


SEG 

LO iS'MPSI 

LO B_MPSI.PGM 

LIB VAPPLB 

LIB TCS500 

LIB 

SAV 

Q 


5.3 EXECUTION COMMAND FILES 


After the run file ^MPSI has been built 
the commands described in Volume III. 
two command files listed below: 

Command File MPS I • 

OPEN I CARD 1 1 
OPEN Ml.D.B 3 1 
CO -END 


the program can be executed by entering 
The execution is set up and controlled by 


Command File MPS I. BATCH 

OPEN CARDS 1 1 
OPEN Ml.D.B 3 1 
OPEN PRINT 2 2 
SEG #MPS1 
C 1 2 3 
CO -END 


CARDS is a disk file containing the batch card input, and ICARD contains the 
single word INTERACTIVE. CARDS or ICARD is accessed by the program via FORTRAN 
logical unit number 5- Ml.D.B is the alloy data base accessed via logical unit 
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number 7* PRINT is the batch printed output written on logical unit 6. 
No printed output is generated by an interactive mode run. 


I 

I 

I 

J 


I 

I 

I 

I 

I 

I 


5-2 


APPENDIX A 
' LISTING 


COOOl) 

C0002) 

COOOS) 

COCOA) 

(0005) 

(OOOf) 

(0007) 

( 000 ») 

(0009) 

( 0010 ) 

( 0011 ) 

( 0012 ) 

(0013) 

(0014) 

(0015) 

(0010) 

(0017) 

(OOlfi) 

(0019) 

( 0020 ) 

( 0021 ) 

( 0022 ) 

(0023) 

(0024) 

(0025) 

(0026) 

(0027) 

(0028) 

(0C29) 

(0030) 

(0031) 

(0032) 

(0033) 

(0034) 

(0035) 

(0036) 

(0037) 

(0038) 

(0039) 

(0040) 

(0041) 

(0042) 

(0043) 

(0044) 

(0045) 

(0046) 

(0047) 

(0046) 

(0049) 

(0050) 

(0051) 

(0052) 

(0053) 

(0054) 

(0055) 

(0056) 

(0057) 

(0058) 

(0059) 

(0060) 


SYSTEM. 


C CONTROLLER FOR CALCULATION OF MACRCSE6RE C AT ION IN A CASTING INGOT 
C _ _ . . . 

C HPS SOLIDIFICATION MODEL 1 (12/79) 

C * DEVELOPED FOR MARSHALL SPACE FLIGHT CENTER 

C BT THE GENERAL ELECTRIC CO.« HUNTSVILLE OPERATIONS — . 

C OF THE SPACE CIVISICN. 

C * A DESCRIPTION OF THE POCEL IS IN THE GE DOCUMENT 

C vMPS SOLIDIFICATION MODEL - 

C VOLUME i: FORMULATION AND ANALYSIS 

C VOLUME II : SOFTWARE DOCUMENTATION 

C VOLUME III: OPERATING MANUAL 


LOGICAL AGAIN* FIRST, STABLE. - - 

C 

C INITIALIZE PROGRAM / GO TO NEXT CASE 

C 

FIRSTS .TRUE. . 

200 CALL IMT (FIRST) 

C 

C ITERATE TO THE SOLUTION CF TPE NONLINEAR STEADY STATE 
C SOLVE FOR PPESSURE* VELCCITY AND FRACTION LIQUID. 

C EST CALCULATES THE INITIAL ESTIMATED SOLLTIEN. 

C ITERATION CONTROL PROVIDED BY SUBRCLTINE SSICON. 

C 

STABLES .TRUE. 

CALL EST 

CALL SSICON ( 1, AGAIN ) 

500 CONTINUE 

CALL PSETUP 

CALL PSOLVE . 

C 

CALL VLCTY 

call FRECKL (STABLE) 

call LFRAC 

CALL SSICON ( 2, AGAIN ) 

IF (AGAIN. AND. STABLE) GO TO. EDO . .. 

C 

C CALCULATE THE MACROSEGREGATION . 

C 

CALL MACSEG ' _ .. 

C 

C OUTPUT PRINTED TABLES AND PLOTS 

C 

CALL OUTCON (FIRST) ' 

C 

FIRSTS .FALSE. - 

GO TC 200 

END 


ORIGINAL PAGE IS 
OF POOR QUALITY 


SUBROUTINE INIT (FIRST! 


(0061) 

(0062) 

(0063) 

(0064) 

(0065) 

(0066) 

(0067) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(G068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

( 0068 ) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 

(0068) 


SUBROUTINE INIT (FIRST) 


C 

C PROGRAM INITIAL! 2ATION* NEXT CASE LCCIC 
C 

C 

C FIRST (INPUT) TRUE DURING FIRST CASE. 

LOGICAL FIFST 


C 

C COMMON BLOCKS 
C 

COMMON /MESH/ 

« 

C 

COMMON /PHYS/ 


C 

COMMON /PROCSS/ 

* 

* 

c 

COMMON /ALLOY/ 

* 


* 


C 

c 


COMMON 

COMMON 


/PMHLTY/ 

/FRSSFQ/ 


(SEE INIT FOR OOCUMENTATIOa 

X(S0)f XX(fiO)« DXf ICIM* NI* NIMf MPt 
Y(50)« YY(50)f DY« JDIM* NJ« NJM* NJF 

T(50t£0)f CL(5Ct50)« DCLOTM* 

RHL(E0t50)« DRHCTM« GL(50«50>« CGLC T M (50 1 50 > • . 

P(52f52>* V(2«5C.5n), AVCSCiO). 

KK(50f50) 

REAL KK 

OXM* OYM« 

GSAVf GFORCE* 

DTOTM* DTDX 

ALNAF(2>« ALREF(20«5>* ADBMEF(20)« 

ILO* CLOf TE# CEt OCLCT, EPR» 

RHL0« ORHDCt RFLCt RPSE* KHSt 
VISC' 

INTEGER ALNAM, ALPEF* APDREF 
GAMMA 

A(2*52«52)« E(52«r2)« i 

DPDY0(50)f CPCYL(SD)* CFDXL(50) 


COMMON /SOR/ XCFl* YCFl* XCFTt YCF2, CCF» 
* PIT* MAXSOP* EFSfOR* ESORI 

INTEGER PIT 


COMMON /SSI/ MAXSSI* EPSSSI 


COMMON /CNTRL/ 


MODEL* BATCH* 
PRCSN* NCW* PINF 
LOGICAL BATCH . 


COMMON /SCR/ 


SCR1(2*50*50)* SCR2(100) 


COMMON /lO/ 


CARD* PRNT* CRT* ADBU* . 

TITLE(20*2>* 

TYFE(25)* LN(1C*25>* NLN* LU(5*2E)« NLU* 
PGHrP(20*5)* Kr.YS<25*5)« RVLU(3*25>* - 
IFMTKID)* RFMTKIO)* r*T2(0>* 

IFMT4(1R>* RFMTA(20)* FMT5(7)* 

FMTeC(3J* FMTA4(2)* TIFMT(16>* 

NLSCRN 

_ , INTEGER CARD* FRNT* CRT* ADBU 

INTEGER TITLE* TYPE, PCHPR 

DIMENSION 1VLU(7*25) _ 

EOUIVALENCr (RVLL.IVLU) 

INTEGER RFMTl* FMT2* RFMT4 * FMT5 
INTEGER FMT80* FMTA4* TIFMT 



SUBRCUTINC IMT IFIRST) 


(0068) 

(0066) 

(0066) 

(0066) 

(0066) 

(0066) 

(0068) 

(0066) 

(0066) 

(0066) 

(0069) 

(0070) 

(0071) 

(0072) 

(0073) 

(0074) 

(0075) 

(0076) 

(0077) 

(0078) 

(0079) 

(0060) 

(0061) 

(0062) 

(0083) 

(0084) 

(0085) 

(0066) 

(0087) 

(0068) 

(0069) 

(0090) 

(0091) 

(0092) 

(0093) 

(0094) 

(0095) 

(0096) 

(0097) 

(0096) 

(0099) 

( 0100 ) 

( 0101 ) 

( 0102 ) 

(0103) 

(0104) 

(0105) 

(0106) 

(0107) 

(0108) 

(0109) 

(0119) 

( 0111 ) 

( 0112 ) 

(0113) 

(0114) 

(0115) 

(0116) 

(0117) 

(0118) 


C 


c 

c 

c 

c 

c 

c 


c 


c 


c 


c 

c 

c 


COMMON /GRAPH/ 




HSCRKt VSCRN* l-k» VWt 
HVL* HWR* VVL« VUUt 
HCHt VCH« 

PBLK(5*10)« NPHLf NPDCH 
INTCCCR HSCRN* VSCRN« HW« VU 
INTCCCR HWLf HWR« VWLt VWU 
INTCCCR HCK« VCH 
INTCCEK PBLK - - 


IF (.NOT.FIRST) GO TO 100 
INITIALIZE hxFD COMMON PARAMETERS 


• /MESH/ 

IDIMs so 

JOIMs 50 

• /CNTRL/ 

MODELS 1 

PRCSNs l.E'« - 

NCWs 4 

RiNFs 1.E37 . 

NMSGs 20 

• /lO/ 

CARDS 5 

PRNTs 6 

CRTs 1 
ADBUs 7 
NLSCRNs 64 

• /GRAPH/ - 

• HSCRNs 1024 

VSCRNs 781 - 

HWs 734 

VWs 575 

TEST FOR BATCH OR INTERACTIVE MODE 


READ (CARO. 50) MODE 
50 FORMAT (A4) 

DATCHs (MODE .NE* 4HINTE) 
C 

C GET INPUT - - 

C 

100 CALL INCON (FIRST) 


C 

C ASSIMILATE INPUT DATA 
C 

C • MESH 

NIMs NI-1 
NIPS NI*1 

OXs OXM/FLOAT(NIM) 

DO 200 Isl.NI 
X(I)s FLOAT! I-n* OX 
XX(I)s (X(I)-X(l))/ CXM 
200 CONTINUE 


NJMs NJ-1 


NJPs NJ«1 

DYs CYH/FL0AT(NJM) 

DO 250 Jsl.NU 


SUDRCUTIKE INIT (FIRST) 


( 0119 ) 

( 0120 ) 

( 0121 ) 

( 0122 ) 

(0123) 

(0129) 

(012S) 

(0126) 

(0127) 

(012(5) 

(0129) 

(0130) 

(0131) 

(0132) 

(0133) 

(0139) 

(0135) 

(0136) 

(0137) 

(0138) 

(0139) 

(0190) 

(0191) 

(0192) 

(0193) 

(0199) 

(0195) 

(0196) 

(0197) 

(0198) 

(0199) 

(0150) 

(0151) 

(0152) 

(0153) 

(0159) 

(0155) 

(0156) 

(0157) 

(0158) 

(0159) 

(0160) 

(0161) 

(0162) 

(0163) 

(0169) 

(0165) 

(0166) 

(0167) 

(0168) 

(0169) 

(0170) 

(0171) 

(0172) 

(0173) 

(0179) 

(0175) 

(0176) 

(0177) 

(0178) 


Y(J)s FLCAT(J-1)« 07 

7V(J)= (7(J)-Y(1))/ OYF 
250 COMTINUE .... 

C * TEHPERATUREt DENSITY. LIQUID COMPOSITK 
TLOs TE ♦ (CLO-CE)/DCLOT 
DTOXs (TLO*TE)/OXH 

DCLDTRs CCLDT * CTDTP 

RHLCs RHLE ♦ DRHDC* (CLC-CE) 

ORHDTHr DRHDC * DCLOTM — 

DO 300 J=lfNJ 

DO 300 1 = 1. NI 

T(I.J)= TE « DTDX*( X(I)-X(1) ) 
CL(I.J)= CE ♦ DCLOT*(. T«I.J)-T(1.J) I 
RHL(1.J)= RHLE -» DRHCC«( CL(I.J)-CLC 

300 CONTINUE 

C * SOR MESH-DEPENDENT COEFFICIENTS 

CCF= .5* (OX. *2) * (DY..2) /(DX.*2 ♦ 
XCFls .5* CCF/ DX 

XCF2S CCF/ (0X..2) 

YCFls .5* CCF/ OY 

YCF2= CCF/ (CY..2) .. 

C 

RETURN 


A 




.4 

... 


COMMON DOCUMENTATION 

/MESH/ X horizontal MESH POINTS (CM) - DISTANCE FROM XF. 

XX NORMALIZED MESH POINTS - (X- XE ) / ( XL- XF ) . 

OX HORIZONTAL MESH SIZE (CM). 

lOIF X CIMENSION OF ALL ARRAYS. 

NI NUMBER OF X MESH POINTS IN CURRENT C ALCUL '-iTION . 

NIM..NIP NI-1. M.l 

Y VERTICAL MESH POINTS (CM) - PHYSICAL DISTANCE 
FROM BOTTOM OF MUSHY ZONE. 

YY NORMALIZED MESH POINTS - Y/L . 

DY VERTICAL MESH SIZE (CM). 

JDIM Y CIMENSION OF ALL ARRAYS. 

NJ NUMBER OF Y MESH. POINTS IM CURRENT CALCULATION. 

NJM.NJP NJ-1. RJ.l 

/PHYS/ T TEMPERATURE FIELD FDE6 C). 

CL LIQUID COMPOSITION (WT FCT SOLUTE). 

OCLDTM PARTIAL OF CL WRT TINE. . 

RHL LIQUID DENSITY (GM/CM...3). 

DRHCTM PARTIAL OF RHL WF.T TIME. 

GL VOLUME FRACTION LIQUID. 

OGLOTM PARTIAL OF GL URT TIME. 

P MODIFIED PRESSLRE ( DYNF S/CH* *2 ) . 

V VELOCITY (CM/S). . 

AVCS FINAL LOCAL AVERAGE COMPOSITION (kT FCT SOLUTE). 

KK PERMEABILITY tCK**2) .. .. . 

/PPOCSS/ DXM WIDTH OF MUSHY ZONE (CM). 

DYM HEIGHT OF MUSHY ZONE (CM). 

GRAV ACCELERATION CUE TO GRAVITY IN THE -Y DIRECTION. 

(CM/S. .2). POSITIVE DOWNWARD. 

GFORCE GRAV IN UNITS CF F=9fl0.66 CM/S. .2. 

USED ONLY FOR . I/C. - ~ - 

DTOTM PARTIAL OF TEMPERATURE WRT TIME (DEC- C/S). 

DTOX PARTIAL OF TEMPERATURE WRT X. (DEG. C/CM). - 

/ALLOY/ ALNAM ALLOY NAME (ALPHANUMERIC). . 

ALREF SOURCES OF ALLOY DATA (ALPHANUMERIC). 

ADBREF ALLOY DATA BASE lOFNlIFIER (ALPHANUMERIC). 


1 


SUBROUTINC 


/PMBLTV/ 

/PRSSEQ/ 


/SOR/ 


/SCR/ 


TLO LIOUIDUS TCKPERATURE *1 COHPOSI1IOK CLC (DEC C). 

CLO BULK LIQUID COHPOSITIOM (WT PCI SOLLTE). 

TE EUTECTIC TEMPERATURE (CECC). 

CE EUTECTIC COMPOSITION (WT PCT SOLUTE). 

OCLDT SLOPE OF PHASE CIACRAH LIDOUIDUS (PCT SOLUTE/DEG C) 
EPR ECUILIBRIUM PARTITION RATIO. 

RHLO OENSITT OF BILK LICUID (6M/CM**3>. 

DRHDC PARTIAL OF RHL WRT CL (GM/CM**3 / FCT SOLUTE). 

RHLE LIQUID EUTECTIC DENSITY (GM/CM**3). 

RHSE SOLID EUTECTIC DENSITY (GM/CH**3). 

RHS SOLID ALLOY DENSITY (OM/CM**?). - 

Vise VISCOSITY OF LIQUID (GM/(CM«S)). 

GAMMA PERMEABILITY CCEFFICIENT (CM**2). 

A COEFFICIENT OF CPACID IN PRESSURE fCLiATION. 

B CONSTANT TERM IN PRESSURE EQUATION. 

DPDYO PARTIAL OF PRESSURE WRT Y AT BOTTOM CF INGOT. 

DPDYL PARTAL OF PRESSURE WRT Y AT TOP OF INGCT. 

DPDXE PARTIAL OF P WRT X AT EUTECTIC ISOTHEMM. 

XCF1.XCF2 COEFFS OF-X CEFIVATIVE TERMS- IN PRESSURE EON. 


YCF1»YCF2 COEFFS 


CEB IVATIVE TERMS 


PRESSURE 


/SSI/ 


/CNTRL/ 


MAXSOR 

EPSSCR 

ESORI 

MAXSSI 

EPSSSI 

MODEL 

BATCH 

PRCSN 

New 


ADRU 

TITLE 

TYPE 


LU«NLU 

PGHDR 


COEFFICIENT CF CONSTANT TERM IN PRESSURE EON. 

AFTER CA.tL TO TSCLVE. NUMBER OF PRESSURE 
ITERATIONS USED. 

MAXIMUM NUMBER OF ITERATIONS ON SOLUTION OF 
PRESSURE EQUATION (SCR TECHNIQUE). 

MINIMUM CONVERGENCE CRITERION FOR SOR TECHNIQUE. 

SOR CONVERGENCE CRITERION DURING CURRENT STEADY 
STATE ITERATION.? SET IN SSICON. 

MAXIMUM NUMBER CF ITERATIONS ON STEACY 
STATE SOLUTION. 

CONVERGENCE CRITERION FOR STEADY STATE SCLUTICN. 
MODEL NUMBER FOR I DENT IFI FAT ION PURPOSES. 

TRUE FOR BATCH MODE. 

FALSE FOR INTERACTIVE MODE. 

l.E-N WHERE N IS THE PRECISION OF THE MACHINE. 
NUMBER OF characters THAT CAN RE STORtC IN AN 
INTEGER. (DEFAULT LENGTH) 

LARGEST FLOATING POINT NUMBER IN MACHINE. 

SCRATCH AREA 1. — 

SCRATCH AREA 2. 

LOGICAL UNIT NUMEER FOR CARD INPUT. 

LOGICAL UNIT NUMBER FOR PRINTED OUTPUT. 

LOGICAL UNIT NUMIER CF CRT FOR INTERACTIVE 
I/O AND GRAPHICAL CUTPLT. 

LOGICAL UNIT NUKPCR OF INPUT ALLOY DATA BASE. 

TWO LINE ALPHANUMERIC TITLE USED ON ALL CUTPUT. 
TYPE(K) IS THE TYPE OF THF KTH INPUT VARIABLE. 

1 INTEGER 

2 REAL — - . - 

LN(l-NLN.K) IS THE ALPHANUMERIC NAME OF THE KTH 
INPUT VARIABLE. 

LU(l-NLU.K) IS THE ALPHANUMERIC UNITS CESCRIPTION 
OF THE KTH INPUT VARIBLE. 

PCHDR(1-20»J) IS THE ALPHANUMERIC HEADER FOR THF 
UTH PAGE (INTERACTIVE) OR PARAGRAPH (HATCH) OF INFL 
KEYS(I.J) IS THE INDEX IN TY PE . LN »LU .R VLU OF THE 
ITh VARIABLE IN THE JTH P AGE /P ARAGR AFH OF INPUT. 
RVLUd .2.3.K) ARE THE VALUE. LOWER EOUND. AND 
UPPER BOUND. RESPECTIVELY. OF THE KTH INPUT VARlAtL 
THE ARRAYS WITH FMT IN THEIR NAMES APE FORMAT 


SCRATCH AREA 
LOGICAL UNIT 
LOGICAL UNIT 
LOGICAL UNIT 


I 


r 

! ]' 




SUDROUTINC IMT (FIRST) 


(0239) 

(0240) 

(0241) 

(0242) 

(0243) 

(0244) 

(0245) 

(0246) 

(0247) 

(024R) 

(0249)' 

(0250) 

(0251) 

(0252) 


STATCHCNTS SET UP IN IMCON. . - 

NLSCRN HAXIHUF NUPBER OF LINES THAT FIT ON THE CRT SCREEN. 
HSCRN WIDTH CF CRT SCREEN IN RASTER UNITS* 

V5RCN HEIGHT OF CRT SCREEN IN RASTER UNITS. 

HU«VU HORIZONTAL.VERTICAL RASTER LENGTH OF PLOT WINCOU. 
HULvHWR HORIZONTAL RASTER COORDINATE OR LcFT.RIGHT SIDE 

OF PLOT WINDOW . - 

VWLtVWU VERTICAL RASTER COORDINATE OF LOUER.DPPER SIDE 
OF plot window. 

PBLK PARAMETER BLOCK FOR PLOTS. 

NPOL NUMBER OF LINES IN PARAMETER RLOCK. 

NPPCH NUMBER OF CHARACTERS PER LINE IN PARAMETER BLOCK. 


C 

C 

C /GRAPH/ 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 


END 


PROGRAM size: PROCEDURE 

0000 ERRORS C<INIT >FTN~R 


• 000631 
EV15.3] 


LINKAGE • 000217. 


STACK > 000030 



SUOROUTINC CST 





C0253> SUHROUTIKE EST ; 

C0254> C 

(0255) C INITIAL ESTI»*ATEn PRESSURE# CL AND CCLDTR# 

(025b) C EXACT SOLUTION FCIt CASE kITH PLANAR ISOT)'CRPS# 

(0257) C LINEAR VARIATION OP RHL« CL AND T IN THE MUSHY ZONE* 

(0258) C AND NO GRAVITATIONAL FORCE. 

(0259) C . . . « . ... . 

(0260) C 

(0280) C CONMON OLOCFS ... ..... (SEE INIT FOR DOCUMENTATION 

(0260) C 

(0261) C - 

(0262) C GL« DCLDTM# VELOCITIES. 

10263) C -■ 

(0264) E= -1./ ^(l.-EPR) 

(0265) GLC= (RHS/PHSE -1.) • CE**E — -- • - 

(0266) GLC- CL0**E ♦ 6LC 

(0267) CE= (CE**E ♦ 6LC)/6LC 

(0268) C 

(0269) DO 200 1=1.NI 

(0270) DO 200 J=itNJ 

(0271) CL(Ita>= (CL(IfJ)**E ♦ GLO/GLD .... 

(0272) n6LDTM(I«J)= E* (GL(I«U)« (RHSF /RHS > 1 . ) *GE ) • DCLDT**/ CUI.J) 

(0273) V(l«l#J)s ( (GL(ItO>*(RHS-RHL(I«J)>-»GEMRHSE-KHS>)/ 

(0274) * (RHL( I«U)*GL( I.J)) )• DTDTH/DTDX 

(0275) V(2*I»J)s 0. .. - - — 

(0276) 200 CONTINUE 

(0277) C 

(0278) C PERMEABILITY 

(0279) C 

(0280) CALL PERM 

(0281) C - ... 


(0282) C ESTIMATED PRESSURE FIELD. ( P- PO- RHL*GRAV*(L -Y ) ) 

(0253) C 

(0284) DO 300 J=1«NJ 

(0285) P(NI#ltU*l)= 0. • 

(0286) FI= ( -VISC*GL(NIf J)/KK(NI«J) )• V(1«M«J) 

(0287) DO 300 II = 2*NI - 

(0288) Is NI-II«1 

(0289) FIPS FI - . 

(0290) FI= ( -VISC»GL(I.J)/KK(I,J) )* V(1.I,J) 

(0291) P(I+l*J*l)s F(I*2fJ#l)- .5»(F1#F1P)«CX 

(0292) 300 CONTINUE 

(0293) C 

(0294) RETURN 

(0295) END - . .. 

PROGRAM size; PPCCEDURE - 000456 LINKAGE - 000120 STACK - 000022 
0000 ERRORS t<EST >FTN-REV15.3D . 



S'UBROUTINC FRCCKL (STABLO 


C0296) SUBROUTINE FRECRL (STABLE) 

(0297) C 

(0298) C CHECKS fCR THE TYPE OF INSTABILITY THAT CAUSES THE FORMATION ~ 
(0299) C CF FRECKLES CR A-SECREGATES. 

(OSOO) C . 

(0301) C THE INSTABILITY OCCURS WHEN THE FLIIC VELOCITY IS GREATER THAN 

(0302) C THE ISOTHERM VELOCITY SO THAT RENOFITE REHELTING OCCURS. 

(0303) C 

(030A) C D(T)/D(TIHE) = PARTL (T >/P ARTL( T IHE ) « V*GRAD(T) .CT. 0 „ 

(0305) C 

(0306) C 

(0307) C STABLE (OUTPUT) TRUE IF NO INSTABILITY OETECTEC. 

(0308) LOGICAL STABLE • -- . 

(0309) C ' 

(0309) C COMHON BLOCKS ... .. (SEE INIT FCR COCUFEM AT ION 

(0309) C 

(0310) C . — 

(0311) STABLE: .TRUE. 

(0312) C 

(0313) DO 200 J:l»NJ 

(031A) DO 200 I=1»N1 

(0315) _ STABLE: STABLE .AND. 

(0318) '■ .NOT.( DT0TH4V(1,I.J)*0TLx" *.GT. 0. ) 

(0317) 20Q CONTINUE 

(0318) C . _ 

(0319) IF (.NOT. STABLE) CALL HSG( 80* 8 OHC ALCULAT 1 ON ABCRTEC - FLOW INST 

(0320) *BILITY LEADING TO FRECKLE FORMATION DETECTED. ) 

(0321) C 

(0322) RETURN _ .... 

(0323) END 

PROGRAM size: PRCCEBURE - 000154 LINKAGE • 000040 STACK - 300016 

0000 ERRORS C <FRECKL>FTN-REV1F.33 


SUBROUTINE LFRAC 


i 


f0324> SUBROUTINE LFRAC 

(032S> C 

C0S26) C CALCULATES LOCAL VOLUME FRACTSON LlOUIDo ^ 

10327) C INTEGRATE LOCAL SOLUTE REDISTRIBUTION EQUATION FROM LIGUIOUS 
(032H) C TO XCI) ALONG CONSTANT V. ASSUMES STEADY STATE SOLUTION. . _ 

{S329) C 

(0330) C 

(0330) E COMMON BLOCKS (SEE IMT FOR COCUMENT AT ICI 

(0330) C — — 

(0331) C 

(0332) C CALCULATE FRACTION LIQUID AND DGLDTM. ■— • — - 

(0333) C 

(033A) E* -1./^ (l.-EPR) U 

(0335) C 

(0336) DO 200 J=ltNJ 

(0337) Els E* ( RHL(NT«J)/FHS )* ( 1. •» V(1 tNI«J) *DTDX/CUTM ) 

(0338) GL(NI«J)s 1. - • - 

(0339) DGLDTM(NI«J)= El* (GL (NI t J ) /CL (N I « J ) ) • DCLDTM 

(0340) C ■ - 

(0341) DO 200 II=2«N1 

(0342) 1= Nl-1141 - - 

(0343) Ells El 

(0344) Els E* ( RHL(I«J)/RHS )* ( 1. « V ( 1 • I* J) * DT CX/ CT DTK ) 

(0345) GL(ItJ>= GL(I*1«J)* ( CL (I t J)/CL( 1*1 «U) )•*( .S«(EI«EI1) > 

(0346) DGLDTH(I«J)s El* (GL ( 1 « J ) /CL ( I t J ) > * DCLDTM ~ 

(0347) 200 CONTINUE 

(0348) C _ ... 

(0349) C CALCULATE NEW PERME ABILinCS. 

(0350) C - . - ... . 

(0351) CALL PERM 

(0352) C 

(0353) RETURN 

(0354) END - . 

PROGRAM size: PROCEDURE - 000252 LINKAGE • 000074 STACK - 0C0020 

0000 ERRORS E<LFRAC >FTN-REV1£.31 — . - 


I 




SUDROUTINC HACSCG 


*0S55> SURROUTINE HACSE6 

f0356> C 

(0357> C CALCULATE THE LOCAL AVERAGE COHPOSITION OF THE FINAL SOLID. 

(0350) C STEADY STATE FORMULATION. 

<03591 C - - 

(0360) C - 

(9360) C COMMON BLOCKS -.(SEE INIT FOR COCUMCNTAT lOf 

(0360) C 

I (0361) C 

(0362) DO 300 J^l.NJ 

(0363) C . .. . . 

(0364) C INTEGRATE SOLID INTERFACE COMPOSITION OVER DENDRITIC GROWTH. 

(0365) C : 

(0366) CSIs 0.^ 

(0367) C . . . . ._ 

(0368) DO 200 I=2fNI 

(0369) CSI= CSI * EPR*.E*(RL(ItJ)«CL(IfJ)«GL(I-l*J)*CL<l-l«J))* 

(0370) • (ALOG(GL(If J))-ALOG(CL(I-l*J)) ) 

(0371) 200 CONTINUE . , 

(0372) C 

(0373) C INCORPORATE ELTECTIC CCMFCSITICN. .. - ... 

(0374) C 

(0375) AVCS(J)= <RHS*CSI ♦ RHSE «GL ( 1 . .J ) *CE ) / . . — 

(0376) * (RHS*(1.-GL(1«J)> ♦ RHSE «GL ( 1 * J) ) 

(0377) 300 CONTINUE 

(0378) C 

(0379) RETURN . . 

(0380) END 

PROGRAM size: PROCEDLRE - 000221 LINKAGE - 000060 STACK - C00024 

0000 ERRORS C<MACSEG>FTN-REV15.3 3 



SUBRCUTINE PLRH 


(038U SUBROUTUE PERM — 

(0362) C 

(03S3> C PERMEABILirv AMD POROSITY MODELS - 

<0384) C 

<0385) C-— - 

<0385) C COMMON SLOCKS <SEE IN!T FOR OOCUMENTATI Cf 

<0385) C 

<0386) C 

<0387) C ISOTROPIC MODEL - - . 

<0388) C 

<0389) DO 2C0 J = 1«NJ • • - 

<0390) DO 2C0 I:1«MI 

<0391) KK<I«J)s AHIMK GAMMA* CL < 1 1 J ) * * 2 • • G AMM A ) • 

<0392) 200 CONTINUE 

(0393) C . . 

<0394) RETURN 

<0395) END * - • ■ . 

PROGRAM size: PROCEDURE - 000067 LINKAGE - 000040 STACK - C00014 

0000 ERRORS t<PERM >FTN-REV15.33 -• 




SUBROI'TINE PSETUP 


(0396) 
(0397) 
C0398) 
(0399) 
(0400 
(0401) 
(0401) 
(0401) 
(0402) 
(0403) 
(0404) 
(0405) 
(0406) 
(0407) 
(0408) 
(040?) 
(0410) 
(0411) 
(0412) 
(041S > 
(0414) 
(0415) 
(0416) 
(0417) 
(0418) 
(0419) 
(0420) 
(0421) 
(0422) 
(0423) 
(0424) 
(0425) 
(0426) 
(0427) 
(0428) 
(0429) 
(0430) 
(0431) 
(0432) 
(0433) 
(0434) 
(0435) 
(0436) 
(0437) 
(0438) 
(0439) 
(0440) 
(0441) 
(0442) 
(0443) 
(0444) 
(0445) 
(0446) 
(0447) 
(0448) 
(0449) 
(0450) 
(0451) 
(0452) 
(0453) 


SUBROUTINE PSETUP . 

C 

C CALCULATES COEFFICIfNTS OF PRESSURE EOUATON. 

C SETS UP eoUNCARY CONDITIONS THAT DEPEND ON SOLUTION VARIABLES. 
C 


C COHMON BLOCKS 


(SEE INIT FOR COCUHENT ATIOI 


C STATEHCNT FUNCTIONS - .... — 

C 

SF(IP.JP)s KK(IP.JP)* RHLdP.JP)/ VISC - 
C 

ASF(IP.JP)= ALOC( SMIPsdP) ) 

C 

PSF(IP»JP)s ALOGt SF(IP.JP)* RFLdP.v'F) ). 
C 


C X-DERIVATIVE CONTRIBUTIONS 

C 

DO 250 J=1.NJ . — 

A(U2t U-»l>= ( ASF(c^U>-ASf(l4J) :/ DX 

DO 200 I:2«NIH 

A(l.l*l.J-»l)= { ASF(I*1«J)-ASF(I-1.J) )/ (£.*DX) 

200 CONTINUE 

C _ . 

A(l»MP.w*l)= ( ASF(NI»J)-ASF(NI-1.J) )/ DX 

250 CONTINUE - 

C 

C Y-OERIVATIVE CONTRIBUTIONS AND REGAINING TERMS ..... 

C 

DO 350 1=1. NI . .... _ - 

A(2«I^1.2 )= ( -ASF(I.3)44,«ASFn»2)-3.*ASF(I.l) )/ (2.*DY) 

BU-»lf2 )= CRAV* RHL(I.l)* 

• ( -BSF(I.3)*4.*LSF(I.2)-3.*BSF(I.l) )/(2.*DY) - 

• ( l./SF(T.l) )* 

• ( (RHL(I.l>“PhS)*C6LCTM(I.l ) ♦ GL ( I . 1 ) * CRHDTM ) 
B(l4l.2)= B(I*1.2) -RHL(N1»1)*GKAV*A(2.I^1.2> 

DO 300 sl=2«NJM 

A(2f I^l. J-»l) = U ASF( 1. J* l)-ASF(l.J-l) )/(2.«0Y) 

C 

B(I^l.J^l)= GRAV* RHL(l.l)*.. 

• ( BSFd. J^1)-PSF( 1. J-1) )/(2.*DY) - 

• ( l./SF(I«J) )• - 

• ( (RHL(I. J)-RHS>*rGLDTM(I.J> ♦ GL ( 1 . .i ) • CRHDT M ) 

ed-»l.J-»l)= Gd^l.J*!) -RHL(NI«J).CRAV*A(2.I-*1.J-»1) 

300 CONTINUE 

A(2.I*1.NJP)= ( 3.*A'Fd.N0)-4..A£F(l.NU-l)^ASF(l.NJ-2) )/ (2.*C 
B(I*1.NJP)= GRAV* RHLd.NJ)* 

• . ( 3.*B£F(l.NJ)-4.*l'SFd.NJ-l)^nSF(l«N.:-2) )/(2..DY> 

• ( l./SFd.NJ) ). 

• ( (RHLd .NJ)-RH£) .LGLDTMd.NJ ) ■» GL (I . N J ) * DRHDTM ) 
Bd^l«NOP)= Ed^l.NJP) -PHL(NI,NJ)»GRAV*A(2»I^1.NJP) 

350 CONTINUE 


ORIGINAL PAGE IS 
OF POOR QUALITY 


1 


SUCR0U11NC PSCTUP 




SUDROUTINC rSOLVC 


(047SI 

C0476) 

<0477) 

<0479) 

<0479) 

<04H0) 

<04fi0) 

<0480) 

<0481) 

<0482) 

<0483) 

<0484) 

<0485) 

<0486) 

<04871 

<0489) 

<0489) 

<0490) 

<0491) 

<0492) 

<0493) 

<0494) 

<0495) 

<0496) 

<0497) 

<0498) 

<0499) 

<0500) 

<0501) 

<0502) 

<0503) 

<0504) 

<0505) 

<0506) 

<0507) 

<0508) 

<0509) 

<0510) 

<0511) 

<0512) 

<0513) 

<0514) 

<0515) 

<0516) 

<0517) 

<0518) 

<0519) 

<0520) 

<0521) 

<0522) 

<0523) 

<0524) 

<0525) 

<0526) 

<0527) 

<0528) 

<0529) 

<0530) 

<0531) 

< 0532 ) 


SUBROUTINE f’SOLVE 


SOLVES 2-0 LINEAR ELLIPTIC EOUATION OF FORM <0«*2)P ♦ 
SUCCESSIVE OVERRELAXATION VrRSION 


A* <0)P ♦ D =■• 0 


COMMON PLOCKS 

..... . - .»SEE INIT FOR COCUMENTATIC 

LOCAL UECLAPATIONS 
LOGICAL OCONV 
REAL LHMAX 



P1T= 0 

PCUT= l.E-3* A0S< PC2»NJF) ) 
NCMK= 12 

OMECAr 1.375 ... . 

OCONVr .FALSE. 

OPTO= 0. . 


200 PIT= PIT41 
TEST= 0. 

PDELP= DELP 
DELP= 0. 

C , 

: update NEUMANN CONDITIONS 


DO 220 I=1«NI 
P<I«lfNJ«2)= Pd + l.NJ) 
P<I*1»1>= P(l*l,3) 

220 CONTINUE 

■ DO 240 J=1.NJ 

P<ltJ*l)= P<3»J*1) 

240 CONTINUE 


-» 2.*CT* 
- 2.-DY* 


OPDYL< I) 
DPDYOU) 


- 2.0DX* DPDXEIJ) 


C 

C 

C 


CALCULATE NEW P 

DO 3C0 J=2»NJP 
DO 3C0 Is2.NI 
OLDP= ra.j) 

P<I.J)= <1. -OMEGA)* 
♦ OMEGA* 


IF < 


PU.d) .. . 

< <XCF2*KCF1*M1«1.J) ) * 

. . <XCF2-XCFl*Aa,I,J>) • 
<YCF2*YCFl*A(2.I«0) > * 

. (YCF2-YCri*A<2,I.J) ) * 
CCF*B<lf..) ) 

FCUT) .AND. (ABS«OLOP) 
C .) ) 


3D0 


<ABS<P<I.J>) .GT 
<P<IfJ)*OLDP .GT 
TESTS AMAXl <TEST, . . , 

2.* ABStrn «J)-OLDF)/ 
DELF= DELF ♦ ADS< P(I.J)-OLCP ) 
CONTINUE 


ru*i,0)* 

P(I-l.O)* 

F (I . J*1 ) ♦ 
FU.J-D* 

.GT. FCUI) .AND. 


(ABS<P( 1 .J))*APS«OLDP)> ) 


C 

C 

c 


DETERMINE OPTIMAL OMEGA 

IF JOCONV) CO TO 400 

IF < MOr<PIT ,NC»'K) .NE.O ) GO TC 400 

LBMAXs CELP/ PDCLP 

IF < LUMAX .LT. .99 ) CO TO 35C 

IF < FIT. LQ. NCHK ) GO TO 400 


SUDROUTINC PSOLVe 


fOSSS) 

<05S4> 

C05S5) 

<0536> 

C0537) 

(0538> 

10S39> 

C0540) 

(0541) 

(0542) 

(0543) 

(0544) 

(0545) 

(0546) 

(0547) 

(0548) 

(0549) 

(0550) 

(0551) 

(0552) 

(0553) C 

(0554) C 

(0555) C PROGRAMMING NOTES 


OCONVs .TRUE. 

IF ( OPTO.NF.O. ) OMEGAS OPTO« . CS • ( 2 i-OPT 0 ) 

60 TO 4 00 ■ .. — 

350 POFTC= OPTO 

OPTO= 2./ <!.♦ SCRT( l.-(LPMAX^CFEGA-l»)**2 / (LFMAX*OMEGA 
OMEGAS OPTO- (2.-OPTO/4. 

IF ( POPTO.EO.O. ) GO TO 400- - * 

OCONVs ( ADS COPTO-POPTO)/ (2. -OPTO) .LT. .05 ) 

IF (CCONV) OMEGAS OPTO 

C 

C TEST CONVERGENCE 
C 


•• 2 ) ) 


400 


IF ( TL^T.LT.ESORI ) GO TO 500 

IF ( PIT.LT.MAXSOR ) GO-TO 200- 

CALL HSG( 36. 36HPRESSURE ITERATION DIO NOT CONVERGE ) 


500 


CONTINUE 

RETURN 


(0556) 

(0557) 

(0558) 

(0559) 

(0560) 

(0561) 

(0562) 

(0563) 

(0564) 

(0565) 

(0566) 

(0567) 

(0568) 

(0569) 

(0570) 

(0571) 

PROGRAM 


C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


EXPANDED MESH - AN EXTRA ROW OR COLUMN- IS ADDED TC EACH EDGE 
OF THE SQUARE ARRAY IN ORDER TO FACILITATE IMPLEMENTATION OF 
THE NEUMANN BOUNDARY CONDITIONS. THE PRESSURE VALUES IN THE 
FICTITIOUS CELLS OUTSIDE THE TRUE MESH ARE UPDATED AFTER EACH 
SOR ITERATION. FOR AN ARRAY STORED ON THE EXPANCEC KESM THE 
ELEMENT WITH INDICES (I.1.J-.1) CCRREEFONDS TC THE FUNCTION 
EVALUATED AT THE TRUE f'ESH POINT (X(I)«Y(U)>. 

DIPICHLET CONDITIONS - THE DIFICHLET PCUNDARY CCNCITICN 
IS IMPLFMENTED BY STORING THE FUNCTION VALUF IN THE P ARRAY IN 
SUCRCUTIKE INIT. THE VALUES OF F ALONG THE EDGES WITH DIRICHLET 
CONDITIONS ARE NOT CHANGED IN FSOLVE OR ELSEWHERE. 

CONVERGENCE - THIS VERSION TESTS THE MAXIMUM RELATIVE CHANGE 
IN PRESSURE AT INTERIOR POINTS. 


END 

size: froceoure - ooioi? 

0000 ERRORS [<PS0LVE>FTN-REV15.33 


LINKAGE - 000153 


STACK - 000034 



« 


SUDROUTINE SSICOK ( ^TRYf AGAIM ) 



C0572) SUBROUTINE SSICON ( NTRY* AGAIN ) 

(0573) C 

(05741 C CONTROLS ITERATION TO STEADY STATE SOLUTION. - - 

(0575) C 

(0576) C 

(0577) C ARGUMENT LIST 

(0578) C NTRY (INPUT) -1. INITIALIZE HERAT ION SCHEKL 

(05T9) C 2 TEST CONVERGENCE AFTER FACH ITERATION. 

(0580) C AGAIN (OUTPUT) WHEN NTRY=2 AGAIN HAS THE FOILCUING HEAMNC 

(0581) C AGAIN=TRUE SHOULD CONTINUE ITERATIONS 

(0582) C - AGAIN = FALSE CONVERGENCE- OR hAXSSI EXCEEDED 

(0583) LOGICAL AGAIN 

(0584) C 

(0584) C COMMON BLOCKS (SEE INIT FOR DOCUMENTATION 

(0584) C 

(0585) C LOCAL DECLARATIONS 

(0586) DIMENSION OLOGL(l) 

(0587) EQUIVALENCE (SCRltOLDGL) 

(0588) C 

(0589) C 

(0590) C NTRY=1 ' - - • 

(0591) C INITIALIZATION ENTRY 

(0592) C . — 

(0593) IF (NTRY.GT.l) GO TO 500 

(0594) C 

(0595) ITSSI= 1 

(0596) DO 200 J = 1»NJ - - 

(0597) DO 200 1=1. NI 

(0598) OLDGL(H(U-l)*NI)= GL(I.U) — 

(0599) 200 CONTINUE 

(0600) ESORI=EPSSOR *10. -- • 

(0601) ' RETURN 

(0602) C ‘ - - - -- 

(0603) C NTRY=2 

(0604) C TEST CONVERGENCE - -- 

(0605) C 

(0606) 500 AGA1N= .FALSE. - - — 

(0607) TEST= 0. 

(0608) DO 550 J=1.NJ - 

(0609) DO 550 1=1. NI 

(0610) IJ= 1«(J-1)*N1 

(0611) TEST= AMAXK TEST. 

(0612) * 2.*^ABS( (CL(I.J)-OLQCL(TJ))/(GL(I.J)*OLDGL(1J)) ) ) 

(0613) 550 CONTINUE 

(0614) WRITE {CRT.560) ITSSI. PIT. TEST - 

(0615) 560 FORHAT( IX. 9HITERATION. 13. 3H. (. 13. 18H PRESSURE CYCLES).. 

(0616) • 15H CONVERGENCE TEST =.1PE10.3 ) - - - 

(0617) IF (TEST.LT.CPSSSI) RETURN 

(0618) C -- - 

(0619) C CHECK MAXIMUM NUMBER OF ITERATIONS 

(0620) C - — 

(0621) IF ( ITSSI. LT.MAXSSI) GO TO 650 

(0622) CALL MSC(40. 40HSTEAOY STATE. SCLLTION DIO. NOT. CONVt RGE > 

(0623) RETURN 

(0624) C - 1 

(0625) C INITIALIZE NEXT ITERATION 

(0626) C ... 

(0627) 650 AGAIN= .TRUE. 

(0628) ITSSIs 1TSSI*1 

(0629) DO 700 J=1.NJ 


SUDROUTINC SSICON ( NTRY* AGRIN ) 



tOG30) 00 700 Isl.NI 

<0631) OLOCK !<»< J-1)*N1>= GL<I«J) 

<0632) 700 CONTIKUL • • 

<0633) IF < TEST .LT. 100.*EPSSSI ) ESCRT= AHINK ESOR 1 • E.*EPSSOR ) 

<0636) IF < TEST .LT. 10.*EPSSSI ) ESORI= EFSSOR - - 

<0635) RETURN 

<0636) C 

<0637) ENO 

PROGRAK size: PRCCECURE - 000572 LINKAGE • 000077 STACK - 000026 

0000 ERRORS C <SSICCN>FTN-REV15.33 




















SUDROUTINC VLCTY 


<063R) SUBROUTINE VLCTY — 

(0639) C 

(0640) C CALCULATE VELOCITY FROM OARCYS LAU 

(0641) C 

(0642) C 

(0642) C COMMON BLOCKS (SEE INIT FOR COCUMENTAT I CN) 

(0642) C 

(0643) C STATEMENT FUNCTION 

(0644) C __ 

(0645) SF(IPtJP)s -KK(IPfJP)/ ( VI SC •EL ( IPt JF) ) 

(0646) C - . . 

(0647) C 

(0648) c . ^ - : . 

(0649) C VX 

(0650) C • ■ 

(0651) DO 220 J=lfNJ 

(0652) V(l,lt U)= SF(1, J)* DPDXE(J)...- 

(0653) C 

. (0654) DO 200 I=2fNlH - _ 

(0655) V(1«I« J): SF(I« J)« ( P (I-»2f )-P( It J'»l) )/ (2.*CX) 

(0656) 200 CONTINUE 

(0657) C 

(0658) V(ltNItJ): SF(NItJ)* (P(Nl4l ) )/OX 

(0659) 220 CONTINUE 

(0660) C 

(0661) C VY 

' (0662) C -. - . 

(0663) DO 320 I=ltNI 

(0664) V(2tltl )= SFdtl }* ( DPDY0(I)4(RHL(Itl)-RHL(NItl))*GKAV ) 

(0665) C 

(0666) DO 300 J = 2tNJH - . 

(0667) V(2tItJ )= SFdtJ )* 

(0668) * ( (P(I«ltU«2)-P(I'»ltJ))^(2.*DY)'» . .. 

(0669) • (RHL( ItU)-RHL(NIt J) >*GR AV ) 

(0670) 300 CONTINUE — 

(0671) C 

{ (0672) V(2tItNJ)= SF(ItNJ)* ( DPDYL.(I)4(RHL(ItNJ)-RHL(NItNJ))*GRAV ) 

I (0673) 320 CONTINUE 

I (0674) C 

(0675) RETURN 

(0676) c : . . 

(0677) C 

(0678) C PRCGRAMHIN6 NOTES 

(0679) C 

(0680) C • NOTE EXTENDED MESH STORAGE OF.P - SEE..NOTES IN PSCLVE. 

(0681) C 

i (0682) END 

, PROGRAM size: PROCEDURE - 000604 LINKAGE - 000104 STACK - OOr.036 

0000 ERRORS t<VLCTY >F TN-REV1E.3 3 _. _ 


I 


SUBROUflNC ADB ( SOLVNT* SOLUTCt WPCTt ERRAOB ) 


( 0001 ) 

( 0002 > 

C0003> 

(CODA) 

<0005) 

<0006> 

(0007) 

<0008) 

<0009) 

< 0010 ) 

< 0011 ) 

<0012) 

<0013) 

<0014) 

<0015) 

<0016) 

<0017) 

<0017) 

<0017) 

<0018) 

<0019) 

< 0020 ) 

< 0021 ) 

< 0022 ) 

<0023) 

<0024) 

<0025) 

<0026) 

<0027) 

<0028) 

<0029) 

<0030) 

<0031) 

<0032) 

<0033) 

<0034) 

<0035) 

<0036) 

<0037) 

<0038) 

<0039) 

<0040) 

< 0041 ) 

<0042) 

<004?) 

<0044) 

<0045) 

<0046) 

<0047) 

<0048) 

<0049) 

<0050) 

<0051) 

<0052) 

<0053) 

<0054) 

<0055) 

<0056) 

<0057) 

<0058) 


SUBRCUTINC ADB ( SOLVNT* SOLUTCt' WPCTt CRR ADB ) 

C 

C ACCESS ALLOY DATA BASE. - ■ 

C RETRIEVE LOCAL PHASE DlACRAHt CERSITlESt VISCOSITY. 

C ASSUMES DATA BASE WAS SET UP WITH RAPE OF SOLVENT FIRST. 
C 


SOLVNT (INPUT) 

SOLUTE (INPUT) 

WPCT (INPUT) 

ERRADB (OUTPUT) 

ALPHANUMERIC NAME OF SOLVENT. 

INTEGER SOLVNT -- - • -- 

ALPHANUMERIC NAME OF SOLUTE. 

INTEGER SOLUTE - - -- - ~ 

WEIGHT PERCENT OF SOLUTE. 

TRUE WHEN ERROR PAS OCCURRED IN 

ACCESSING DATA BASE OR WHEN VALUE OF 

WPCT IS INVALID. 

LOGICAL ERRADB 

COMMON BLOCKS 

(SEE INIT FOR DOCUHENTATIOF 

LOCAL DECLARATIONS 


DIMENSION NAMTRY(2) 
INTEGER OUTU 

* - ■ * *— — . 


ERRADB= .FALSE. 

OUTUs CRT 

IF (BATCH) CUTU= PRNT - 

IF (BATCH) WRITE (PRAT. 305) 

IF (.NOT. BATCH) CALL NEWPAC - 

SEARCH FOR SOLVENT -SOLUTE COMBINATION IN DATA 

REWIND ACeU ..*** bug IN PRIME REWIND 

CALL SEARCH ( INTS(4)t SHKl.C.R. INTS(ADBU 
CALL SEARCH ( 1NTS(1>« 6PM1.C.H* INTS(ACBU 
READ (ADBU«220«END=500.ERR=540) ADCREF 
>00 READ (ADBU«225.ENO=4C0«ERR=540) NAMTRVt CL 
READ (ADBUt220.ENO=540tERR=540 ) ALREF 
READ (ADEU»230tEND=540.ERR=E40) DCLDT. EPR 
READ (ADEUt230«ENDs540«ERR=S40) DRHDCt RHS 
READ ( ADeU.230«END=54C«ERR=540) VISC 
IF ( NAMTRY( 1) .NE.SCLVNT .CR. NAMTRY(2).NE 
IF ( (UPCT.LT.CLLOU) .OR. ( UFC T . GT« C Lhl GH) 


-4) ) 
-4) ) 


low. CLHIGP 

. CE. TE 
« RHLF. ?hSE 

.SOLUTE ) GO TO 200 
) GO TO 2D0 


J20 FORMAT! 20A4 ) 

>25 FORMAT! A4.6X. A4.6X. 2E10.4 ) 

>30 FORMAT! 8E10.4 ) . . - - 

ALLOY LOCATED. DISPLAY CATA TO BE USED -IN CALCULATI ON . 


WRITE (OUTU.315) ADBREF -- — 

WRITE (0UTU.32C) SOLVNT. SOLLTE:. CLLCU. CL 

WRITE (OUTU.Z40) DCLCT. EPR. CE. TE 

WRITE (OUTU.345) DRHDC. RHS. RHLE. RHSE 
WRITE (OUTU. 350) VISC 


IF (BATCH) RETURN 

WRITE (CRT. 360) 

FORMAT ( ill I8HENTER P 


HIGH. SOLUTE. ALREF 




TO POOCCCO) 






SUBROUTINE AOB ( SOLVNT* SOLUTEt UPCT* ERRAOB I 


(00921 

(0093) 

(0094) 

(0095) 

(0096) 

(0097) 


(OIOS) 

(0106) 

(0107) 

(0108) 

(0109) 

( 0110 ) 

( 0111 ) 

( 0112 ) 

(0113) 

(0114) 

(0115) 

(0116) 

(0117) 

(0116) 


(0059) 

(0060) 


READ (CRT,FHTA4) 
IF (1RSP.CG.4HP 


IRSP 

) RETURN 


(0061) 


write: 

(CRTtF 

(0062) 

(0063) 

C 

GO TO 

355 

(0064) 

305 

FOBHAT 

( IHl) 

(0065) 

315 

FORPAT 

(//IX 

(0066) 

(0067) 

320 

FOB PAT 

• 

(//IX 

(0068) 



/ ( 

(0069) 

340 

FORMAT 

(//IX 

(0070) 



/IX 

(0071) 


* 

A, . - . . 

(0072) 


* 

/IX 

(0073) 


* 


(0074) 

(0075) 


* 

/IX 

(0076) 


* 

/IX 

(0077) 




(0078) 



/) 

(0079) 

345 

FORMAT 

(//IX 

(0080) 

(0081) 


* 

/i'X 

(0082) 


• 

/IX 

(0083) 


* 

. 

(0064) 

(0085) 

• 

* 

/IX 

(0086) 


* 

/IX 

(0087) 



. 

(0086) 


* 

/) 

(0089) 

(0090) 

350 

FORMAT 

(//IX 

(0091) 


* 

/) 


2CHALLOY DATA oASE - t 20A4 
25HS0URCE OF INFCRPATION FOR « 
5X« 1PE10.3* 46 TO f lPE10.3t 
(« 20A4) ) 

13HPHASE DIACRAP. - — 


) 

2Xt 

lOH 


A4« 

UT. 


IH-t 

PCT. 


A4« 

• A4« 


45H 


45H 


45H 


45H 


TEP.PERATLRF-COPPCSITION SLOPE 
3X» IPEIO.Z* 19H PCT SOLUTE / 
EQUILIBRIUM partition RATIO 
3X, 1PE10.3* 

EUTECTIC COPFOSITION 
3Xt lPE10.3f IIH PCT SOLUTEf 
EUTECTIC TLffPERATURE 
3X« 1PE10.3* 6H DEC C« 


CFG C* 


9HDENSITIES* 


45fl^ 


45H 


45H 


45H 


cc*T OS I T 1 0 N -nra s i sl op e 

3Xt 1PE1C.3. 24H (CK/CM**3) 
SOLID DENSITY 
3X* 1PF10.3, 9H GK/CK**3* 
LIQUID EUTECTIC DENSITY 
3X, lPriO.3, 9H GP/CM**3. 
SOLID EUTECTIC DENSITY 
3X. 1PE10.3* 9H CH/CM**3» 


/ PCT SOLUTEt 


45HVISC0SITY 

3Xt IPElO.Zt 


12H GM/(CH*SEC)t 


C 

c 

C 

C 

c 

c 


SOLVENT-SOLUTE COMBINATION NOT IN DATA BASE FOR CORPCSITION RANGE 
BRACKETING L'PCT. 

PRINT ERROR MESSAGE AND ABORT HATCH JOB OR RETURN CONTROL TO 
INTERACTIVE CPERATOP. 


(0098) 

400 

ERRADB 

= .TRUE. 





(0099) 


WRITE 

(0UTUt42 

0) SOLVNT 

t WPCTt 

SOLUTEt ADD 

REF 

(0100) 

420 

FORMAT 

( IXt 

S2H*«*«* 

UNABLE 

TO LOCATE t 

A4, lFE10.3t 2H -t 

(0101) 


. * 

. 

- . 

14H IN 

DATA BASE.t 


(0102) 



//IXt 

29H 

DATA BASE IDENTIFIE 

R is:t 5Xt 20A4t 

(0103) 



//IXt 

42H 

ALLOYS 

IN DATA BASE 

ARE LISTED BELOUtt 

(0104) 



//) 






A4 


430 


CALL 

READ 

READ 

read 


CLHIGH 


435 


440 


460 


REWIND ADBU DUG IN PRIME REWIND 

CALL SEARCH ( It.TS(4)t 6HMl.C.Et INTS(ACOU-4) ] 

SEARCH ( INTSdIt SHMl.D.Dt- 1NTS( ACBU-4) 1 
(APBUt220tEND=500.ERR=540) 

(ADBU«?25,LND=460iCRR=540 ) NAMTRYt CLLOWt 
( ADPUt220tEND=460.rRR=54C) ALREF 

DO 435 lR = li3 . . 

READ (ADPU.220tEND=460.ERR=540) 

WRITE (OLTU«440) NAMTRV* CLLCUt CLHIGht NAMTRY(2) - 

format ( fXt A*t iH-t A4t 5Xt lPE10.3t 4H TO t lPE10.3t 

• lOH UT. PCT. . A4 ) - 

CO TO 430 

RETURN - 


J 


SUBROUTINE ADB < SOLVNTt SOLUTCt UPCTt FRRAOB > 


I 


.. 10119* C ERROR IN DATA BASE SETUP. 

<0120* C 

10121) 500 WRITE <OUTU.«2n» 

<0122* 520 FORMAT ( //IX« 31H***** ALLOY DATA BASE IS EMPTY. ) 

10123* CALL EXIT 

1012A* C 

10125* 540 WRITE (CUTU.560* ... 

10126* 560 FORMAT 1 //1X« 46H***** MISSINC DATA OR FORMAT ERRCK IN DATABASE 

10127* CALL EXIT - 

10128* C 

<0129* END 


PROGRAM size: PROCEDURE - C02421 LINKAGE - 000133 STACK - 000030 

0000 ERRORS C<ADD >FTN-B EV15.3 3 r - 

V 



■f 


SUBROUTINE ADISP C DAS* ARRAY* Nl* N2* NS* IJC* NC * NAME ) 


(0130) 

f0131> 

(0132) 

(0133) 

(0134) 

(0135) 

(0136) 

(0137) 

(013R) 

(0139) 

(0140) 

(0141) 

(0142) 

(0143) 

(0144) 

(0145) 

(0146) 

(0147) 

(0146) 

(0149) 

(0150) 

(0151) 

(0152) 

(0153) 

(0153) 

(0153) 

(0154) 

(0155) 

(0156) 

(0157) 

(0158) 

(0159) 

(0160) 

(0161) 

(0162) 

(0163) 

(0164) 

(0165) 

(0166) 

(0167) 

(0168) 

(0169) 

(0170) 

(0171) 

(0172) 

(0173) 

(0174) 

(0175) 

(0176) 

(0177) 

(0176) 

(0179) 

(0180) 

(0181) 

(0162) 

(0183) 

(0184) 

(0185) 

(0186) 

(0187) 


SUDRCUTUE ADISP ( DAS* ARRAY* Nl* N2* NS* IJC* NC* NAME ) 
DISPLAYS ARRAY 


ARGUMENT LIST 


(INPUT) 


ARRAY (INPUT) 
N1*N2*M3 (INPUT) 


(INPUT) 


(INPUT) 

(INPUT) 


TRUE WHEN ARRAY IS TO BE DISPLAYED ON CRT 
SCREEN. FALSE WHEN ARRAY IS TO bE PRINTED. 
LOGICAL DAS 

ARRAY TO DISPLAY — - - 

CIHENSICN ARRAY (M«N2*N3) 

DIMENSIONS CF ARRAY. - - — 

Nl IS 1 FOR SCALAR ARRAYS. 

.2 FOR VECTOR ARRAYS SUCH AS V. 

N2 IS THE X DIMENSION. 

N3 IS THE Y DIMENSION. - 

EXTENDED MESb FLAG - SEE NOTES IN PSOLVE 

0. USUAL MESH - - - - 

1 EXTEMDED MESH 

NUMBER Of CHARACTERS IN NAME - - 

TITLE TO DISPLAY OVER ARRAY 
DIMENSION NAME (NC) 


COi'MON blocks 


INIT FOR OOCUHENTATlOf 


local DECLARATIONS 

INTEGER STAR* OUTU 
DATA NPL /lO/* 

* STAR /IH*/ 


OUTU= PRKT 

IF (DAS) OUTU= CRT 

IF (.NOT. DAS) WRITE (PRNT*200) 

IF (DAS) CALL NCUPAG 

WRITE (0UTU.FMT8C) TITLE. . - 

NN= NC/NCU 

IF ( NN*NCU .LT. NC ) NN= NN*1 _ 

WRITE (CUTU.220) ( NAME(IN)* 1N=1«NN ) 

NLNSs 4 ♦ (NN/20)* 3 

IF ( NN-(NN/20) .GT. 0 ) NLNS= NLNS* 3 

MDX ALLOWS FOR 1-D ARRAY (Y VARIATION ONLY). 

NBLK IS THE NUMBER OF PRINTED BLOCKS THE ARRAY WILL CCCLFY. 
NPL IS THE MAXIMUM NUMBER OF X VALUES PER LINE. 

NDX= Nl 

IF ( N2.EC.1 ) NDXs I 

NBLK= MDX/NPL 

IF ( NPL*NBLK .LT. NDX ) NBLK= NDLK^l — _ 

LOOP THROUGH PRINTED BLOCKS. 

DO 500 IELK = 1*NDLK - 

IF ( (.NOT. DAS) .OR. (NLSCRN-NLNS .GT. D ) GO TO 3C0 

CALL WAIT ... . 

CALL NEUPAG 

NLNSs 0 

SQO NLNSs NLNS* 3 





SUBROUTIKC ACISP ( DAS* ARRAY* Nl* N2* NS* IJE* NC * NANC > 


(01B8) 

(0189) 

(0190) 

(0191) 

(0192) 

(0193) 

(0194) 

(0195) 

(0196) 

(0197) 

(0198) 

(0199) 

( 0200 ) 

( 0201 ) 

( 0202 ) 

(0203) 

(0204) 

(0205) 

(0206) 

(0207) 

(0208) 

(0209) 

( 0210 ) 

( 0211 ) 

( 0212 ) 

(0213) 

(0214) 

(0215) 

(0216) 

(0217) 

(0218) 

(0219) 

( 0220 ) 

( 0221 ) 

( 0222 ) 

(0223) 

(0224) 

(0225) 

(0226) 

(0227) 

(0228) 

(0229) 

(0230) 

(0231) 

PROGRAM 


IF (NOX.KC.l) NLNSs 
11,= (inLK-l)*NPL ♦! 
IU= M1N0( IL*NPL-1* 
IF (NOX.NE.l) WRITE 
IF (NOX.ro. 1) WRITE 


MNS« 2 

NDX ) 

(OUTU*320) 

(0UTU*325) 


(XXd >*I = Il.*IU) 


WRITE (OUTU*340) (STAR* I=1L*IL') 


kITHIN each block* LOOP THROUGH Y FROM TOP OF INGOT TO BOTTOM. 


350 


DO 480 JJ=l*Nt) 

IF ( (.NOT. DAS) 
CALL WAIT 
CALL NEWPAG 
NLNSs O'* 

NLNS= NLNS* 1 
J= NJ-JJ*1 
WRITE (OL'TU*420) 


OR. (NLSCRN-NLNS .GE. M) ) -GO TO 350 


YY(U)* (ARRAYd* I« Itif* I JE> * I = IL*IU) 


470 


IF (Nl.FO.l) GO TO 480 
NLNS= NLNS« Nl 
DO 470 IN1=2*N1 
WRITE (OLTU*440> 

CONTINUE 

WRITE (0LTU*445) 


(ARRAY(IN1«I«IJE*J-»IJE)* I = IL«IU) 


oeo CONTINUE 


500 CONTINUE 


IF ( DAS .ANC. (NLNS.GT.O) ) CALL WAIT 


RETURN 


200 

220 

32C 

325 

340 

420 

440 

445 

size: 


FORMAT 

FORMAT 

FORMAT 


( IHl) 

< // dX«20A4) 


( 


FORMAT 
FORMAT 
FORMAT 
FORMAT 
format 
END 

PROCEDURE 


( 

( 

( 

( 

(/) 


//IX* 

/IX* 

/IX* 

IX* 

IX* 

IX* 


7H 
7H 
7H 
7H 

0PF5 

7H 


Y/L 


Y/L 


) N 

•* 50X* 14H(X-XE)/( XL-XO* 
•* 10(1X*0PF5.2«5X> ) 

• ) _ 

** 10(3X«A1*7X) ) 

2K •* I0(lX*lPil0.3) ) 

•* 10(1X*1PE10.3> ) 


0000 ERRORS KAOISF >FTN- 


- 001206 
REV15.3D 


LINKAGE -000124 


STACK 


000046 


SUBROUTINE BATCHI (FIRST) 


(0232) 
(0233) 
(0234) 
(0235) 
(0236) 
(0237) 
(023B) 
(0239) 
(0240) 
(0241) 
(0242) 
(0242) 
(0242) 
(0243) 
(0244) 
(024S) 
(0246) 
(0247) 
(0248) 
(0249) 
(0250) 
(0251) 
(0252) 
(0253) 
(0254) 
SC. 255) 
(5256) 
(0257) 
(0258) 
(0259) 
(0260) 
(0261) 
(0262) 
(0263) 
(0264) 
(0265) 
(0266) 
(0267) 
(0268) 
(0269) 
(0270) 
(0271) 
(0272) 
(0273) 
(0274) 
(0275) 
(0276) 
(0277) 
(0278) 
(0279) 
(0280) 
(0281) 
(0282) 
(0283) 
(0284) 
(0285) 
(0286) 
(0287) 
(0288) 
(0289) 


SUBROUTINE BATCHI (FIRST) . 

C 

C READS BATCH INPUT CAROS. - • - - 

C PRINTS INPUT VALUES. 

C CHFCKS FOR INPUT ERRORS (FULL SCAN P.CFORE ABORT). 
C TERMINATES JCB NORMALLY IF NC NEb INPUT CASE. 



C FIRST (INPUT) TRUE FOR FIRST CASE ONLY. 

LOGICAL FIRST 


C 

C COPHON BLOCKS (SEE INIT FOR DOCUMENTATI 01 

c 

C LOCAL DECLARATIONS 

LOGICAL ERROR. ERRAOB ... ~ 

INTEGER EFMT (15) 

C 

C 

ERRORS .FALSE. — 

IF (FIRST) CALL S,ETHOL( EFHT. 60. 60H( 1 X. 5 OH* ** * * FORMAT ERROR' Dl 

• ECTEO WHILE READING NEXT ITER ) ) - . . . 

C 

C READ CASE NAME — -- . .... 

C 

200 READ (CAPD.210.ENOS1200) (TI TLE ( IT .2 ) .1 T=1 *20 ) 

ERRORS .false. 

210 FORMAT (20A4) ... 

C 

C PRINT PROGRAM IDENTIFICATION PACE .. 


C 


220 ' 


WRITE 

(PRNT. 

FORMAT 

( IHl. 


/✓IX 


/✓IX 


✓ IX 


✓ IX 


✓ IX 


✓ IX 


✓ IX 


✓ IX 


/) 


220) MODEL ..- - 

2SHMATERIALS PROCESSING IN SPACE. 

• 3EHMACR0SECREGATI0N IN A CASTING INGOT, 
t 5HM0CEL. 13. 

• 44H « UNIDIRECTIONAL SOLIDIFICATION OF A BINARY. 

6H ALLOY. 

♦24H * STEADY STATE SOLLTICN. 

. 43H • PLANAR ISOTHERMS. RECTANGULAR MUSHY ZONE. 

. 26H * TEMPERATURE FIELD INPUT. , 

• 31H * NO CONVECTION IN BULK LIQUID. 

• 40H * ISOTROPIC PERMEABILITY Ks GAMMA *GL**2. 


C READ ALLOY 

READ (CARD.FMTAA.rNDsllOO) ALNAHUl 

READ (CARD.FMTA4,ERR=250.£NOsll00) ALNAM(g) 

READ (CARD.* .ERH = 250.END = HG0) CEO 

GO TO 3C0 

250 WRITE (PRNT.EFMT) 

ERRORS .TRUE. 


C 

C SET UP CASE TITLE BLOCK. 
C 


300 ENCODE ( GO. TIFMT* TITLE ) ALNAM(l). CLO. ALNAM(2)« MCCEL 
CALL T1MESA( TITLF(I4.1) ) 

CALL DATr.5A( TITLE(17.1) ) 

WRITE (FRNT.FMTRO) TITLE 


C 

C GET ALLOY INFORMATION FRCM DATA BASF. 




SUBROUTINE DATCHI (FIRST) 


CALL AOH ( «LNAH(1)« ALNAN(2)t CLO* CRRAOB > 

ERRORS ERROR. OR. ERRACB 

READ AND PRINT REMAINING INPLT PARAMETERS. 

LOOPS THROUGH DATA IN ORCER DEFINED DY KEYS IN IKCON. 

SCAMS ALL INPUT* CHECKING FOR FORMAT ERRORS AND FOR PARAMETER 
BOUND VIOLATIONS . 

WRITE (PRNTtSOS) 

WRITE (PRNT.FMTRO) TITLE - 

WRITE (PRNTtSlO) 

i05 FORMAT JlHl) 

>10 FORMAT < /IX* lOHCASE INPUT* // ) 


IPGPHs 0 

IPGPHs IPCPH41 — - 

IF ( KEYSd* IPGPH) .EO. 0 ) GO TO 1000 
WRITE (PRNT*FMT60) ( PGHGR ( IP « IPGPH) * IPs 1 * 20) 
ITEMS 0 

ITEMS ITEM-H 

KEYS KEYSC ITEM* IPGPH ) 

IF ( KEY .EQ. 0 ■) GO TO £2C 
IF C TYPE(KEY) .EO. 2 ) GO TO 


- INPUT INTEGER VALUE *** 

READ <CARD***ERRs540.ENC=1100) IVLU(1*KEY) 

IF ( (IVLU(1*KEY).6E.I VLL(2*KEY)) ,»AND. 

(IVLU(1*KEY).LE.1VLL(3*KEY)) GO TO 5!iC 


WRITE (PRNT*IFMT«) 
ERRORS .true. 

60 TO 550 

WRITE (PRNT.EFMT) 

ERRORS .TRUE. 

WRITE (PRNT*1FMT1) 


IVLU(2*KEY)* IVLU(3*KEY) 


ITEM* (LN(ILN*KEY)*ILNs 1.NLN)* 
IVLUltKEY)* (LUC ILU.KEY) . ILU=1*NLU) 


GO TO 530 


» INPUT REAL VALUE •** - . 

READ ( CARD***tRRsEtO*ENDsllOO) RVLU(1*KEY) 

IF ( (RVLUd.KEY) .GE.RVLL(2*KEV) ) .AND. 

(RVLUd«KCY).LE.RVLU(3»KCY)) ) CO TO 57C 


WRITE (PRNT*RFMT4) 
ERRORS .TFUE. 

GO TO 570 

WRITE (PRNT*EFMT) 

ERRORS .TRUE. 

WRITE (PRNT.RFMTl) 

GO TO 530 


RVLL(2*KEY)* RVLU(3*KCY) 


ITEM* <LN(ILN*KEY).ILN=1*NLN)* 
RVLU(1*KEY) * (LUC 1 LU *K E Y ) « 1 LU= 1 *NLU ) 


TERMINATE JOB OR RETURN 


IN'CON. 


(.NOT. ERROR) RETURN 


WRITE (PRNT.1020) 
1020 FORMAT ( //IX* A3H< 
• /IX* ASH 

GO TO 200 


SCAN OF INPUT FOR THIS CASE COMPLETE.* 
CASE aborted due TO ERRORS NOTED ABOVE. 


OP POOR QUALITY 



SUBROUTINE BMCHI (FIRST) 


(0350) 1100 WRITE (FRNT«1120> — 

(0351) 1120 FOKHAT ( //IXt 45H****« RUN ABORTED CUE TO MISSING INPUT CARDS. ] 

C0352) CALL EXIT 

(0353) C 

(035A) 1200 IF ( FIRST .AND. .NOT. ERROR ) GO TO 1100 - - ■ 

(0355) IF (.NOT. ERROR) WRITE (PRNTtl22C) 

(0356) 1220 FORMAT ( //IX. 24H**«** NORMAL TERMINATION ) - 

(0357) CALL EXIT 

(0358) C 

(0359) END 


PROGRAM size: PROCEDURE - 002144 LINK AGE 00 0225 ~ STACK - 000020 

0000 ERRORS C<BATCHI>FTN-REV15.33 


I 






SUDROUTINC 1*CT1 (FIRST) 



(0360) 
(0361) 
(0362) 
(0363) 
(0364) 
(0365) 
(0366) 
(0367) 
(0367) 
(0367) 
(036R) 
(0369) 
(0370) 
(0371) 
(0372) 
(0373) 
(0374) 
(0375) 
(0376) 
(0377) 
(0378) 
(0379) 
(0380) 
(0381) 
(0382) 
(0383) 
(0384) 
(0365) 
(0386) 
(0387) 
(0388) 
(0389) 
(0390) 
(0391) 
(0392) 
(0393) 
(0394 ) 
(0395) 
(0396) 
(0397) 
(0398) 
(0399) 
(0400) 
(0401 ) 
(0402) 
(0403) 
(0404) 
(0405) 
(0406) 
(0407) 
(0400) 
(0409) 
(0410 
(0411) 
(0412) 
(0413) 
(0414) 
(0415) 
(0416) 
(0417) 


SUOROUTINC lACTl (FIRST) 


C CONTROLS INTCRACTIVE INPUT 
C 
C 

c 


FIRST (INPUT) 

TRUE FOP FIRST 
LOGICAL FIRST 

CASE ONLY. 

. . . . . „ 

COMMON BLOCKS 

. .. 

(SEE INIT FOR 

COCUMENTATICN 

LOCAL DECLARATIONS 
LOGICAL ERRADR 
DIMENSION IRSP(l) 


-■ 






INITIALIZE TERMINAL CONTROL SYSTEM. 

IF (.NOT. FIRST) GO TO 200 

CALL INITT( 1200 ) 

CALL TERM(3,1024) 

CALL CHRSIZ(4) 


C PUT PROGRAM ID PAGE ON SCREEN. 
C 


WRITE (CRT. 180) MODEL • . . 

180 FORMAT ( 1X» 2THMATERIALS PROCESSING IN SPACE. 

* //IX. 3bHMACROSEGREGATION IN A CASTING INGOT. 

* //IX. 5HM0DEL. 13. 

* /IX. 44H * LNIDIRECTICNAL S CL I DI F I C AT I ON OF A BINARY. 

* 6H ALLOY. 

. - /iX. 24H • STEADY STATF SOLUTION. 

*- /IX. 43H * PLANAR ISOTHERMS. RECTANGULAR MLSHY ZONE. 

* /IX. 26H * TEMPERATURE FIELD INPUT. 

* /IX. 31H * NO CONVECTION IN BULK LICUID. 

* /IX. 40H * ISOTROPIC PERMEABILITY K= GAMMA*GL«*2. 

* /) 

C GET CASE TITLE 

C . ..... 


200 IF (.NOT. FIRST) CALL NCUPAG 

WRITE (CRT. 210) . - . - . 

210 FORMAT ( //// 3RHENTER CASE TITLE (UP TO 80 CHARACTERS). 

• / 80 (IH.) ) 

READ (CRT.220) ( T I TL C ( 1 T . 2 ) . I T = 1 . 2 0) 

220 FORMAT (20A4 > 


C 

C ALLOY INPUT . . . . 

C 

300 CALL NEUPAG — .. . __ 

305 WRITE (CRT, .310) ALNAM(l). ALNAM(2).' CLO 

310 F(j:>MAT (// 5HALL0Y. . - . . 

• // 5X. RHSOLVEN'T:. 2X. A4. 

• / 5X. RHSOLLTE: . 2X. A4. 17H WEIGHT PERCENT;, IPLIO. 
WRITE (CRT, 320) 

320 FORMAT (/ 26HENTER A TO CHANCE ALLOY OR. - - - -• 

• 19H P TO PROCEED. ) 

IRSP(1)= 4H — « 

321 READ (CRT,FMTA4,ERR=322> IPSP 

IF ( IRSF(l) .rc. 4HF ) GO TO 400 „ . 

IF ( IRSF(l) .LO. 4HA ) GC TC 325 


'W 




I 




I 


I 


SUDROUTINC lACTI (FIRST) 


(OAIB) 

(0A19) 

(0A20) 

(0A21) 

(0422) 

(042S) 

(0424) 

(0425) 

(0426) 

(0427) 

(0428) 

(0429) 

(0430) 

(0451) 

(0432) 

(0433) 

(0434) 

(0435) 

(0436) 

(0437) 

(0438) 

(0439) 

(0440) 

(0441) 

(0442) 

(0445) 

(0444) 

(0445) 

(0446) 

(0447) 

(0448) 

(0449) 

(0450) 

(0451) 

(0452) 

(0453) 

(0454) 

(0455) 

(0456) 

(0457) 

(0458) 

(0459) 

(0460) 

(0461) 

(0462) 

(0463) 

(0464) 

(0465) 

(0466) 

(0467) 

(0468) 

(0469) 

(0470) 

(0471) 

(0472) 

(0473) 

(0474) 

(0475) 

(0476) 

(0477) 


322 


325 

330 


340 


345 

350 


360 


WRITE (CRT.FMT5) 

CO TO 321 
WRITE (CRT»330) 

FORMAT ( 38H....EFTEP SOLVENT (UP TO 4 CHARACTERS) ) 
READ (CRT»FPTA4) ALNAR(l) . 

WRITE (CRT. 340) 

FORMAT ( 37H. ...ENTER SOLUTE (LP .70.4 CHARACTERS) ) 

READ (CRT.FHTA4) ALNAMI2) 

WRITE (CRT. 350) . 

FORMAT ( POHENTER WEIGHT PERCENT ) 

READ (CRT«*.ERR = 360) CLO 

GO TO 400 

WRITE (CRT.FMT5) - - . 

GO TO 34^5 


C 

C 

C 


GET ALLOY INFORMATION FROM DATA 8ASE. 


400 


CALL ADD ( ALNAM(l). ALNAM(2). CLO. ERRADB 
IF (ERRADB) GO TO 305 . 


set up case TITLE 


ENCODE ( 80. 
CALL TIME$A( 
CALL DATEJA( 


TIFMT. TITLE ) 
T1TLE(14.1) ) 
TITLE(17vl) ) 


ALNAM(l). CLO. ALNAM(2). MCDEL 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 


LOOP THROUGH INPUT SELECTION PAGES. 

EACH PAGE IS A SEPARATE DISPLAY. VARIABLES INCLUCED IN EACH PAGE 
ARE DETERMINED DY ARRAY KEYS SET UF IN INCCN. A 2ERC IN KEYS 
INDICATES THE END OF LIST FOR THE PACE. A ZERO IN KEY F < 1 . IF AGE ) 
INDICATES THE END OF PAGES. 

LN AND LU ARE VARIABLE-NAME AND VAR I ABLE -UMTS LABELS. 

(I/R)VLU( 1.2.3. KEY) ARE THE VALUE. LOWER BOUND. AND UPPER BOUND. 
RESPECTIVELY OF INPUT VARIABLE NUMBER KEY. 


'AGE= 0 


600 


610 


620 


IPAGEs IPAGE'*! 

IF ( KEYS (1. IPAGE) 

CALL NEWFAG 

WRITE (CRT.FMTRO) TITLE. 

1TEM=0 

ITEM= ITEN^I 
KEYS KEYS( ITEM. IPAGE) .. 
IF (KEY. Eft. 0) CO TC 630 
IF ( TYPE(KEY) .Eft. 
WRITE (CRT.IFMTl) 


EO. 0 ) GO TO 800 


<PCHDR(1P.1PA6E).1P=1.2Q ) 


IF ( TYPE(KEY) .E«. 
WRITE (CRT.RFMTl) 


1 ) ..... . . .. 

ITEM. <LN(ILN.KEY» .ILN=1.NLN) . 
IVLU(I.KCY) . (LU (ILU.KEY) .ILL=1.NLU) 
2 ) 

ITEM. (LN( ILN.KEY) .ILNsl.NLN) . 
RVLUd.KPY). (LUULU.KEY».ILU=1.NLU) 


GO TO 620 


630 

640 


WRITE (CRT. 640) , . .. , . 

format ( /// 31HINTER ITEM NUMOt R TO CHANGE. OR 
/ 29H P. ^ -TO PROCEED. ) 

IRSP(1)= 4H 

READ ICRT.FMTAA.ERRS650) IRSF 
IF URSP( 1) .FQ.4HF ) CC TC 6f 0 

IF (1RSP(1).EG.4H ) CO TC 650 

DECODE ( NCU. *♦ IRSP. ERP=65C ) ITEMC 


HlAi 








I 


SUHROUTINC lACTI (FIRST) 


(0478) 

(0479) 

(0480) 

(0481) 

(0482) 

(0483) 

(0484) 

(046S) 

(0486) 

(0487) 

(0488) 

(0489) 

(0490) 

(0491) 

(0492) 

(0493) 

(0494) 

(0495) 

(0496) 

(0497) 

(049P) 

(0499) 

(0500) 

(0501) 

(0502) 

(0503) 

(0504) 

(0505) 

(0506) 

(0507) 

(0508) 

(0509) 

(0510) 

PROGRAM 


IF ( (1TFFC.lt. ITCH) .ANC. (ITCMC.GT.O) ) 
WRITC (CRTtFKTS) 

GO TO 630 

KCV= KCYS (1TEHC*IPAGC) 

IF ( TYPE(KCy) .Cr, 2 ) GO TO 680 

WRITE (CRT*FFT2) (LN ( ILN .KE Y ) ♦ I LN = 1 ,^LN ) - 

READ (CRT«*«ERR=C 70) IVLUU.KEY) 

IF ( (IVLUltKEY).Gr.lVLU(2«KEY)) .AND. 

► (lVLt(l*KEY> .LC. IVLU(3.KEY) ) ) GO TO 

WRITE (CRT,IFMT4) IVLK2.KEY). IVLU(3»KEY1 
GO TO 660 

WRITF^ (CRT.FMT5) ^ 

GO TO 660 

WRITE (CRT.FPT2) ( LN( ILN, KE Y ) » ILN =1. NLN ) 
READ (CRT.*.EPR = 69C) RVLUU.KEY) 

IF ( (RVLU(lfKEY).GE.RVLU(2<KEY>) .AND. 

» (RVLUn»KEY).LC.RVLU(3»HEY)) ) GO TO 

WRITE (CRT,RFHT4) R VLU ( 2 . KE Y « RVL L ( 3 »KE Y ) 

GO TO 660 - -- • 

WRITE (CRT,FMT5) 

GO TO 680 - - 

MESSAGE CN SCREEN DUR ING COKFUT AT ION. - ~ 


CALL NEUPAC 
WRITE (CRT.810) TITLE 
FORMAT ( 32HCALCULATION IN 
► /// 2(20A4/) // ) 


PROGRESS FOR CASEi 


SIZE: 


ERRORS 


• RETURN 

END -- 

PROCEDURE - 002622 
<IACTI >FTN-REV15.33 


LINKAGE - 000204 


- - 


r 


SUBRCUTINC INCOM IFIRST) 


(0511) 

(0512) 

(0513) 

(0514) 

(0515) 

(0516) 

(0517) 

(0518) 

(051B) 

(0516) 

(0519) 

(0520) 

(0521) 

(0522) 

(0523) 

(0524) 

(0525) 

(0526) 

(0527) 

(0528) 

(0529) 

(0530) 

(0531) 

(053?) 

(0533) 

(0534) 

(0535) 

(0536) 

(0537) 

(0538) 

(0539) 

(0540) 

(0541) 

(054?) 

(0543) 

(0544) 

(0545) 

(0546) 

(0547) 

(0548) 

(0549) 

(0550) 

(0551) 

(0552) 

(0553) 

(0554) 

(0555) 

(0556) 

(0557) 

(0558) 

(0559) 

(0560) 

(0561) 

(0562) 

(0563) 

(0564) 

(0565) 

(0566) 

(0567) 

(0568) 


SUDROUTINC INCON (FIRST) -■ 


INPUT CONTROLLER 


FIRST (INPUT) 


TRUE FOR FIRST CASE ONLY. 
LOGICAL F IRST - 


COMMON BLOCKS 


(SEE IMT FOR COCUMEN T AT I ON ) 


INITIALIZE KEYS TO INPUT ARRAYS , - — ... 

KEYSU1.I2) IS THE INDEX OF THE II ST ITEM ON PACE OR PARAGRAPH 12. 
ZERO IS AN ENC-OF-LIST INDICATOR FOR BOTH ROBS. AND COLUMNS. 


DATA KEYS / It 2t 3. 4. 21*0t. 

> 5t 24*0f 


6f 7t 6t 9t I 
2S*Ct 25*0 / 


lit 12t 19*0t 


SET UP STANDARD CASE AND BOUNDS - FIRST CASE ONLY 

ALSO SETS UP LABELS FOR GOTH BATCH AND INTERACTIVE DISPLAYS. 


IF (.NOT. FIRST) 60 TC 200 

NLN= 10 . - . 

NLU= 5 

ALNAM(1)= 4HAL - 

ALNAM<2)= 4HCU 

CLO= 4.5 _ — 

TYPE(1)= 2 

CALL SETHOLI LNCltUt 40t - 

* . 40HHUSHY ZONE WIDTP 

.CALL SETHOLI LUUtDt 20t 20H(CM) 

RVLUdt 1)= 5. 

RVLU(2. 1)= 0. 

RVLU(3t 1)= RINF 

TVrE(2)= 2 

CALL SETH0L( LN(lt2)t 40t 

* 40HHUSHY ZONE HEIGHT 
CALL SETHOLC LU(lt2)t ?0t 20KCM) 

RVLUdt 2)= 10. . 

RVLU(2t 2)= 0. 

RVLU(3t 2)= RINF 

TYPE<3)= 2 

CALL SETPOLI LNd.3)t 40t 

* 40HCOOL1NC RATE 

CALL SETHOLI LUdt3)t 20t 20h(CEG C/SEC). 
RVLUdt 3)= .396 

RVLU(2t 3>= 0. . ... 

RVLU(3t 2)= RINF 


40t 

ZONE HEIGHT 
?0t 20H(CM) 


RVLU(2t 3>= 
RVLUdt 2) = 
TYrE(4)= 2 
CALL SETHOU 


CALL SFTHOL< LUdt4)t 
RVLUdt 4)= 1. 

RVLU(2t 4)= 0. 

RVLU(3t 4)r RINF 
TYPEC5)= 2 

CALL SETHOL( LN(lt5)t 
> 40HGAMMA 


LNd.4)t 40t 
40HGRAVITATIONAL FORCE 
LUdt4)t 20t 20H(G) 

1 . . 

0 . 


SUBROUTIMC INCON (FIRST) 


(0569) 
(0570) 
(0571) 
(0572) 
(0573) 
(0574) 
(0575) 
(0576) 
(0577) 
(0578) 
(0579) 
(0580) 
(0581) 
(0582) 
(C583) 
(0584) 
(0585) 
(0586) 
(0587) 
(0586) 
(0589) 
(0590) 
(0591) 
(0592) 
(0593) 
(0594) 
(0595) 
(0596) 
(0597) 
(0598) 
(0599) 
(0600) 
( 0601 ) 
(0602) 
(0603) 
(0604) 
(0605) 
(0606) 
(0607) 
(0608) 
(0609) 
(0610) 
(0611) 
(0612) 
(0613) 
(0614) 
(0615) 
( 0616 ) 
(0617) 
(0618) 
(0619) 
(0620) 
(0621) 
(0622) 
(0623) 
(0624) 
(0625) 
(0626) 
(0627) 
(062' * 
( 


CALL 

RVLU 

RVLU 

RVLU 

TYPE 

CALL 


CALL 

IVLU 

IVLU 

IVLU 

TYPE 

CALL 

* 

CALL 

IVLU 

IVLU 

IVLU 

TYPE 

CALL 

* 

CALL 

RVLU 

RVLU 

• RVLU 
TYPE 
CALL 

* 

CALL 

IVLU 

IVLU 

IVLU 

TYPE 

CALL 

* 

CALL 

RVLU 

RVLU 

RVLU 

C 

C SET UP P 
C 


. SETHOL 
1(1* 5)= 
l(2t 5) = 
M3* 5) = 
1 ( 6 ): 1 
. SETHOL 

. SETHOL 
1 ( 1 * £)= 
M2* 6) = 
M3* 6) = 
:(7)= 1 
. SEXHOL 

SETHOL 
1(1* 7)= 
M2* 7) = 
M3* 7) = 
!(8)= 1 
. SETHOL 

, SETHOL 
1(1* n)= 
1 ( 2 * 8 )= 
M3* 8) = 
:(9)= 2 
. SETHOL 

. SETHOL 
Ml* 9) = 
M2* 5) = 
M3* ^) = 
Mil):: 1 
. SETHOL 

. SETHOL 
Ml*ll) = 
M2*ll) = 
M3*ll) = 
;( 12 )= 2 
. SETHOL 

, SETHOL 
Ml*12)= 
M2*12): 
M3*12) = 


( LU(1*5)« 20* 2CH(CM**2) > - 

f.E-T 

RINF 

( LH(1*6)* 40* 

40HNUKPER OF HORIZONTAL HESH POINTS 
( LU(1*6)* 20* 20H ) 

10 

( LN(1*7)* 40* - 

40HNUMDER OF VERTICAL HESH POINTS 

( LU(1*7)* 20* 20H -- ) 

20 

JDIM 

( LN(1*8)* 40* 

40HMAXIPUH NUHOER CF PRESSURE ITERATIONS 
( LU(1*8)* 20* 20H ) 

500 

1 

2000 ■ 

( LN(1*9)* 40* 

40HPRESSURE CONVERGENCE CRITERION 

( LU(1*9) * 20* 20H - - ) 

l.E-5 

RINF 

( LN(1*1D* 40* 

40HHAX NUMBER CF STEADY-STATE ITERATIONS 
( LU(1*1D* 20* 2CH ) 

1 

500 — - 

( LN(1*12)* 40* _ 

40HSTEACY-STATE CONVERGENCE CRITERION 

( LU(1*12)* 20* 20H _ ) 

l.E-4 

5.*FRCSN 

RINF 


AGE/PARAGRAPH TITLES AND I VO FORMATS 


CALL SETHOLC PGHCRIl*!)* 80* 80HSOLI CIF ICA 


CALL 
• RS 
CALL 
CALL 
CALL 
CALL 
.•LIE 


SETH0L( PCHDR(1 *2)* 80* 80HFERMEAP ILI 

SETHOL( PGHDR(1*3)* 80* 80HNUHEPICAL 

SFTHOL( IFNT1*40*40H( IX* 12* 5X* lOA 
SETHOL( RFMT1*40*40H( IX* 12* 5X* lOA 
SETHOL( FPT?,?0*2rH( 7H ENTER * 10A4 
SETHCL( IFPT4, 72* 72H( IX* 42H****« 
IN RANGE* no* 3H TO* 110 ) ) 


TION PROCESS PARAHETEfS 

) 

TY MODEL FARANETEFS 

- ) 

METHODS CCNTROL PARAPET 

4, no* 5X« 5A4 ) 

4* 1PE10.3* 5X* 5A4 ) 

) ) 

INPUT ERROR* VALUE MUST 



SUOROUTINC INCON <FIRST) 


(0629) 

CALL 

SETFOL( 

RFMT4* 

eo* 

eoH( 

(0630) 

• LIF 

IN RANCr 

* IFEIO. 

3* 

3K TO* 

(0631) 

CALL 

SETHOL( 

FMT5* 

28* 

28H( ; 

(0632) 

CALL 

SETHCL( 

FMTBO* 

12* 

12H( < 

(0633) 

CALL 

SETHOL ( 

FMTA4* 

6 * 

8H( < 

(0634) 

CALL 

SETHOL( 

TIFMT* 

64* 

64H( . 

(0635) 

*TION 

MODEL* 

13* 33X 

) . 

.) ..- 


1X« 42H***«* INPUT ERROR* VALUE MUST 
IFE10.3 > } 

22H****« INVALID RESPONSE) ) 

/IX* 20A4) ) 

A4 ) > - 

A4« QPF8.4* 4)(* A4* 4X« 20HSOLICIFIC 


(0636) 

(0637) 

(063B) 

(0639) 

(0640) 

(0641) 

(0642) 

(0643) 

(0644) 

(0645) 

(0646) 

(0647) 

(064S) 

(0649) 

(0650) 

(0651) 

(0652) 

(0653) 

(0654) 

(0655) 

(0656) 

(0657) 

(0658) 

(0659) 

(0660) 

(0661) 

(0662) 

PROGRAM 


GET BATCh INPUT 

200 IF (BATCH) CALL BATCHI (F IRST ) - - — - - 

V. 

GET INTERACTIVE INPUT — - 

IF (.NOT. BATCH) CALL lACTI (FIRST) - — - 

EXTRACT VALUES FROM INPUT ARRAY AND CONVERT TO INTERNAL LNITS (CGS). 


DXK: RVLU(1*1) 

DYM= RVLL'(1*2) 
DTDTM= -RVLU(1*3) 
GFORCE= RVLU(1*4) 
GRAV= CFORCE *980.66 
GAMMAS RVLU( 1.5) 

NIs 1VLII(1«6) 

NJs IVLU(1.7) 
MAXSORs iVLUd.n) 
EPSSORs RVLUd.") 
OMEGAS F.YLL'(l.lC) 
MAXSSIs IVLUdfll) 
EP.SSSIs RVLU(1.12) 


RETURN _ . 

END 

size: FRCCEOURE - C02314 

0000 ERRORS KlNCON >F TN-R E VI 5. 3 3 


LINKAGE - 000342 


STACK - C00016 



C0663) SUBROUTIKC HSG ( NCH* KCSSGC > 

C0664> C 

C066S> C DISPLAYS HtSSACL ON PRINTED CUTPLT CR CRT. 


(0666) 

C 



1 O DD f # 
(0668) 
(0669) 
(0670) 

C NCH (INPUT) 

C MESSCE (INPUT) 

NUMBER OF CHARACTERS IN 
MESSAGE TO DISPLAY. 
DIMENSION MESSGE(NCH) 

MESSAGE. 

1 U D f 1 9 

(0671) 

C COMMON BLOCKS 

(SEE 

IMT FOP DOCUMENTATION 

1 Qb f 1 1 

C0672> 

iniLTxi 

C LOCAL OeCLAFvATlONS 
TNTrnrR niiTii 







1 Ob f X 1 

(0673) 

(0676) 

(0677) 

(0678) 

( n&7Qt 

c 

NN= NCH/NCU 
IF (NN*NCU .LT. 
0UTU= PRNT 

tc r unr n at ru « 

NCHI NN=NN4l - 

nilTII— T 

.... 

(0680) 

(0681) 

WRITE (OUTU«100> (MESSGE (IN') «IN=ltNN) 
100 FORMAT ( 1X« 5(1K«), IX* 2CA4 ) 

- 


C0682) C 

(0683) RETURN 

t068A> END 

PROGRAM size: PROCEDLRE - 000124 LINKAGE - 0000*5 - STACK > 000G22 

0000 ERRORS C<MSG >F YN-REVl 5. 3 3 



SUBROUTINE OLTCON (FIRST) 


(0685) 

(0686) 

(0687) 

(0688) 

(0689) 

(0690) 

(0691) 

(0692) 

(0692) 

(0692) 

(0693) 

(0694) 

(0695) 

(0696) 

(0697) 

(0698) 

(0699) 

(0700) 

(0701) 

(0702) 

(0703) 


(0726) 

(0727) 

(0728) 

(0729) 

(0730) 

(0731) 

(0732) 

(0733) 

(0734) 

(0735) 

(0736) 


SUBROUTINE OUTCON 
OUTPUT CONTROLLER 

• 

IP TR!;.T% 









FIRST (INPUT) 

TRUE FOR FIRST 
LOGICAL FIRST 

CASE ONLY. 

- 

COMMON BLOCKS 

. 

.. .(SEE IMT FOR 

DOCUMENT ATiCr 

LOCAL DECLARATIONS 

DIMENSION IRSP(l) 
DIMENSION RLPR(l) 
EQUIVALENCE (SCRlt 
LOGICAL FAESl 







BLPR) 







IF (.NOT.BATCH) GO TO 300 


C BATCH OUTPUT 
C 


(0704) 


CALL 

ADISP 

( 

.F 

(0705) 


* 


_ 

20 

(0706) 

C 





(0707) 


CALL 

ADISP 

( 

.F, 

(0708) 


* 



36 

(0709) 

c 





(0710) 


CALL 

ADISP 

( 

.F 

(0711) 


* 



28 

(0712) 

c 





(0713) 


CALL 

AOISF 

( 

.F 

(0714) 


. * 



24 

(0715) 

c 





(0716) 


DO 220 J=1 

fNJ 

(0717) 


DO 220 1=1 

fNI 


(0718) 

220 

BLPR( 

!♦( J- 

1) * 

NI 

(0719) 


CALL 

ACISP 

( 

.F 

(0720) 


• 



32 

(0721) 

C 





(0722) 


CALL 

ADISP 

( 

.Fi 

(0723) 


* 



16 

(0724) 

c 





(0725) 


CALL 

ADISP 

( 

.F, 


1* IDiHt 


1* IDlHf 


JCIH* 

) . . 

JUIH* 


Of 


Of 


36f 36HLK3UID COMPOSITION <WT PCT SCLLTL) 


If IDlMf 


JDIM( 


2Bf 28HLIQU1D DENSITY (GM/CM**3) 

E.f GLf - !;> ICIFf JOIMf 
24f 24HVCLUME FRACTION LIOUID ) 


Of 

) 


NI f 


E.f Vf 7f ICIPf 

16f 16HVEL0CITY (CK/S) ) 


N Jf 


JDlMf 


JOIMf 


Of 


Of 


Of 


40f 40HFINAL LOCAL AVERAGE COMPOSITION (WT PCT) ) 


RETURN 


C INTERACTIVE DISPLAYS - TABLES OR PLOTS. 

C .... 

CALL BELL 

CALL TSENG * . 

PASS1= .TRUf . 

IF (.NOT.PASSl) CALL NEUFAG 

PASS1= .FALSE. 


300 


320 


(0737) 

WRITE (CRT, 340 

) 




(0738) 

340 FORMAT ( /// 

33HENTER 

T 

TO 

(0739) 

• / 

27H 

G 

TO 

(0740) 

* / 

29H 

Q 

TO 

(0741) 

(0742) 

• / 

IRSP(1)= 4H 

33H 

N 

TO 


•* 


SUBROUTINE OtTCON (FIRST) 


(0743) 

(0744) 

(0745) 

(0746) 

(0747) 

(0748) 

(0749) 

(0750) 


READ (CRT*FKTA4*ERR=7.50) 
IF ( IRSPiD.EC.AHT ) 
IF ( IRSP(l) .E0.4H6 ) 
IF ( IRSP(l) .EQ.4H0 ) 
IF ( IRSPIl) .EC.4HN ) 
WRITE ICRT«FMT5) 

GO TO 345 


IRSP --Ok, 

GO TO 

GO TO 7C0^y>.<k^ 
CALL FXIT 
RETURN . ^!-rs 




1 

0751) 

c display tabular 

OUTPUT 

„ — 


- 


(0752) 

C 








(0753) 

500 

CALL NEWPAG 




■ ■ 

' 


(0754) 


WRITE (CRT. 

FMT80) 

TITLE 



! 

(0755) 


WRITE (CRT. 

510) 


— — - 


— 


(0756) 

510 

FORMAT! V/ 

16H 

1 

TEMPERATURE. 



i 

(0757) 


• / 

24H 

2 

LIQUID CCMPCSITION . 




(0758) 


* / 

2 OH 

3 

LIQUID DENSITY . 



! 

(0 759) 


* / 

28H 

4 

VOLUME FRACTION L ICUID . 





(0760) 


* / 

2 OH 

5 

PRESSURE (P-PC). 




(0761) 


• / 

S4H 

6 

PRESSURE - BULK HYDROSTATIC R. 

— 

— 

1 

i 

(0762) 


* / 

16H 

7 

VELOCITY . 


- 

! 

(0763) 


* / 

36H 

8 

FINAL LOCAL AVERAGE COMPOSITION. 


■ - 


(0764) 


* / 

35H 

9 

PRESSURE ECUATICN COEFFICIENTS, 



*61 

(0765) 


• / 

31H 

10 

-LOCAL SOLIDIFICATION RATE ) 




(0766) 

(0767) 

(076B) 

(0769) 

(0770) 

(0771) 

(0772) 

(0773) 

(0774) 

(0775) 

(0776) 

(0777) 

(0778) 

(0779) 

(0780). 

(0781) 

(0782) 

(0783) 

(0784) 

(0785) 

(0786) 

(0787) 

(0788) 

(0789) 

(0790) 

(0791) 

(0792) 

(0793) 

(0794) 

(0795) 

(0796) 

(0797) 

(0798) 

(0799) 

(0800) 

(0801) 

(0802) 


TO DiSFLATf 


WRITE (CRT«535) 

FORMAT! /// 4lHfcNTER ITEM NUMBER OF TABLE TO DIS 

. / 19H P TO PROCEED. ) 

IRSP(1)= 4H - • 

READ (CRT*FMTA4,Ei.K-540) IRSP 

IF ( IRSP(1).EC.4HP ) go TO 320 - 

IF (IRSP(l).EC.AH ) 60 TO 540 

DECODE! NCWf ♦♦ IRSP. ERR=540 ) ITEM 

IF ( ITEM.GT.O .AMD. ITEM.LT.il ) GO TO 550 

WRITE (CRT.FMT5) - 

GO TO 530 

CO TC (560. 570.580.5^:0. 600.605. 610.62C. 630.640). 


TO 550 


ADISP 


GO TO 


ADISP 


TC SCO 


ADISP 


TO 500 


ADISP 


TO SCO 


.TRUE.. T. 1. IDIM. UDIM. 

20. 20HTEMPERATURE (DEG C) ) 


.TRUE.. CL. 1. IDIM. JDIM. 

36. 36HLIQUID COMPOSITION <WT PCT 


.TRUE.. RHL*. - 1. IDIM. JDIM. 
28. 28HLICUID DENSITY (CM/CH..3) 


0 . 

SOLUTE) 


.TRUE.. GL. 
24. 24HV0LUME 


1. IDIM. JDIM. 
FRACTION LIQUID ) 


DO 602 J=1.NJ . 

DO 602 1=1. NI 

KLPR(I*(J-1) »NI )= P(I*1.J*1) 
CALL ADISP ( .TRUE.. BLPP. 

I .... 32 . 32HPRESSURE 

GO TC 500 


ADISP 


.TP UE . . 


* RHL(NI.J)*GRAV*(Y(N.)-Y( 
1 . NI . NJ. 0 . 

(F-PO) (DYNES /CM**2 ) ) 


IDIM*2. JDIM*2. 


SUBROUTINE OUTCON (FIRST) 


(0803) 


• 

(0804) 


CO TO 500 

(0805) 

C 


(0806) 

610 

CALL ADISP ( 

(0807) 



(0808) 


GO TO 5G0 

(0809) 

C 


(0810) 

620 

CALL ADISP ( 

(0811) 


• 

(0812) 


GO TO 500 

(0813) 

C 


(0814) 

630 

CALL ADISP ( 

(0815) 


• V 

(0816) 


CALL ADISP ( 

(0817) 


* ...... 

(0818) 


GO TO SCO 

(0819) 

C 


(0820) 

640 

CALL ADISP ( 

(0821) 


• 

(0822) 


GO TO 500 

(0823) 

C 


(0824) 

C DISPLAY PLOTS 

(0825) 

C 


(0826) 

700 

CONTINUE 

(0827) 


CALL GPHCCN 

(0828) 


GO TO 320 

(0829) 

C 


(0830) 


END 

PROGRAM 

SIZE: 

PROCEDURE ■ 


44* 44HFRESSURE -BULK HYDROSTATIC P (C YNE S/CH* *2 ) 

.TRUE,. V. 2. IDIM. JDIhT 0. 

16. 16HVEL0CITV (CP/S) ) 


• TRUE., AVCS. 1. 1. JOIH. («. 

40. 40HFINAL LOCAL AVERAGE CO HP OSI T 1 Oh (WT PCT) 


•TRUE*. A. 
4. 4HA . ) 
•TRUE.. B. 
4. 4H0 ) 


2. IDIR«2. JD1H«2. 1. 
1. IDIH«2. JDIK^2. 1. 


•TRUE*. DGLCTP. 1. IDIH. JDIH. 
28. 28H*LCCAL SOL ICIFICATION RATE 


0 . 

) 


002441 

0000 ERRORS C <OUTCCN>FTN-REV15.33 


LINKAGE - 000150 


STACK 


000030 



SUBROUTINE SETHOL f ARRAY* NCH* HOLCCN > 


(0831) 

(0832) 

(0833) 

(083A) 

(0835) 

(0836) 

(0837) C 

(0838) C ARGUMENT LIST 


SUBROUTINE SETHOL ( ARRAY* NCH* HOLCCN 


C 

C 

C 

C 

C 


PUTS HOLLERITH CONSTANT 
USED TO AVOIC THE CRUDE 
DATA statement. 


INTO ARRAY. 
RESTRICTIONS 


OF THE ANSI 


(0839) 

(0840) 

(0841) 

(0842) 

(0843) 

(0844) 

(0845) 

(0645) 

(0845) 

(0846) 

(0847) 

(0648) 

(0849) 

(0850) 

(0851) 

(0852) 

(0853) 

(0854) 

PROGRAM 


C 

C 

C 

C 


array (INPUT) HOLLERITH STRING WILL BE STORED IN ARRAY. 

INTEGER ARRAY (NCH) 

NCH (INPUT) NUMBER OF CHARACTERS IN HOLLERITH STRING. 

HOLCCN (INPUT) HOLLERITH STRING TO STORE. 

INTEGER HCLCCN (NCH) 


COMMON BLOCKS 


(SEE INIT FOP CCCUMENTATICN 


100 


size: 


NN= NCH/NCU - - 

IF ( NN«NCU .LT. NCH ) NNs NN^l 

DO 100 INsl.NN 

ARRAY(IN)= HOLCCN(IN) 

CONTINUE 


RETURN 

END 

PRCCEDURC - 


000057 


LINKAGE * 000026 


STACK > 000024 


0000 ERRORS E<SETHCL>FTN-RCV15.33 


SUBROUTINE WAIT 


10855) SUDRCUTINE WAIT • 

C0B56) C 

10857) C WAIT FOR OPERATOR RESPONSE. 

C0858) C 

<0859) C 

<0859) C COMMON BLOCKS <SEE INIT FOR COCL'MEN T AT I C) 

<0859) C 

<0860) C 

<0861) 140 READ (CRT.FMTA4) IRSP .. - 

<0862) IF <1RSP.ER.4KP ) RETURN 

<0863) WRITE ICRT.FHTB) 

<0864) WRITE ICRT.160) 

10865) 160 FORMAT (18HENTER P TO PROCEED)- — - -- 

<0866) GO TO 1«0 

<0867) END . - .... ._ 

PROGRAM SI2E: FRCCEDURE • 000066 LINKAGE • 000041 STACK - 000012 

0000 ERRORS C<WA1T >F TN-R EVl 5. 33 




I 


‘ ! . 


■ ' V 
t 


(0002) 
(0003) 
(0004) 
(0005) 
(0006) 
r nnn 

* 

c 

C DRAW AND LABEL AXES. 
C 

(0008) 

c 

HHIN 

(INPUT) 

(0009) 

c 

HMAX 

(INPUT) 

(OOiO) 

c 

HOFF 

(INPUT) 

(0011) 

c 


. 

(0012) 




(0013) 

c 

NHTCS 

(INPUT) 

(0014) 

c 

NHMTCS ^ 

(INPUT) 

(0015) 

c 



(0016) 

c 

NHLAB 

( INPUT) 

(0017) 

c 

HLABEL 

(INPUT) 

(OOIB) 




(0019) 

c 

VMIN 

(INPUT) 

(0020) 

c 

VMAX 

(INPUT) 

(0021) 

c 

VOFF 

(INPUT) 

(0022) 

c 



, (0023) 



_ 

(0024) 

c 

NVTCS 

(INPUT) 

(0025) 

c 

NVMTCS 

(INPUT) 

(0026) 

c 



(0027) 

c 

NVLABl 

(INPUT) 

(0028) 

c 

VLABLl 

(INPUT) 

(0029) 




(0030) 

c 

NVLAB2 

(INPUT) 

(0031) 

c 

VLABL2 

(INPUT) 

(0032) 


. 


(0033) 

c 

NVLAB3 

(INPUT) 

(0034) 

c 

VLABL3 

(INPUT) 


NVLAB2* VLABL2* NVLAB3* VLABL3 ) 


<0035) 

(0036) 

(0036) 

(0036) 

(0037) 

(0038) 

(0039) 


C- 

C 

c- 

c 

c 

c 


HINIHUK VALUE ON H0R170NTAL AXIS. 
MAXIKUM value ON HORIZONTAL AXIS. 
VERTICAL CFFSET OF HORIZONTAL AXIS 

RASTER UMTS. 

INTEGER HOFF 

NUHOER OF HORIZONTAL TIC SPACES. 
NUMBER OF MINOR TIC SPACES BPTUEEN 
EACH PAIR OF MAJOR TICS. 

NUMBER OF CHARACTERS IN THE LAPEL. 
AXIS LAPEL (ALPHANUMERIC). 

INTEGER HLABEL (NHLAB) 

MINIMUM VALUE ON VERTICAL AXIS. 
MAXIMUM VALUE ON VERTICAL AXIS. 
VERTICAL OFFSET OF X AXIS FROM VWL. 
RASTER UNITS. 

- INTEGER- VOFF 

NUMBER OF VERTICAL TIC SPACES. 
NUMBER CF MINOR TIC SPACES BETWEEN 
EACH PAIR CF MAJOR T/ICS. 

NUMBER OF CHARACTERS IN VLABLl. 

AXIS LABEL 1 (ALPHANUMERIC). 

INTEGER VLABLl (NVLABl) 

NUMBER OF CHARACTERS IN VLABL?. 

AXIS LABEL 2 (ALPHANUMERIC). 

INTEGER VLA6L2 (NVLAB2) 

NUMBER CF CHARACTERS IN VLAPL2. 

AXIS LABEL 3 (ALFHANUMFRIC) . 

INTEGER VLABL3 (NVLAB3) 


FROM VWL. 


common BLOCKS 


.-(SEE INIT FOR DOCiiMENTATICr 


SET UP HORIZONTAL AXIS AND PUT ON LABEL. 


(0040) 

CALI 

1 (0041) 

CALL 

(0042) 

CALL 

, . (0043) 

CALL 

1 (0044) 

CALL 

j . (0045) 

CALL 

(0046) 

CALL 

(0 04 7) 

IHL = 

i (0048) 

IVL = 

(0049) 

CALL 

i . (0050) 

1 , (0051) C 

CALL 


CALL AOUTST( NHLAB* HLABEL ) 


(0052) 

(0053) 

(0054) 

(0055) 

(0056) 

(0057) 

(0058) 


SET UP VERTICAL AXIS AND PUT ON LAPELS. 


CALL Yr.TAT( 0 ) 

CALL YZERO( 1 ) 

CALL VFPM( 2 ) 

CALL YLENE VCH ) 
CALL YTICS( NVTCS ) 










SUBRCUTINC AXES ( HKIM* HKAX* HOFF* NHTCS* NHHTCS* NHLAD* HLABEL* 



. <0059) CALL YMTCSI NVHTCS ) 

; <0060) CALL OLIMY< VMIN* VMAX ) 

; <0061) HNVLAC= KAX0< NVLADl* NVLAC2* NVLAD3 ) - . ~ . 

<0062) 1HL= MAX0< 0* HU'L^VCFF-L INt'DT (rWVLAB )-VCH/2-2 ) 

! <0063) IVL= VWU - VW/<2*NVTCS) 

<0064) IF < NVLAB2 .GT. 0 > IVL: IVL ♦ <VCH«l)/2 

. <0065) IF NVLAB3 •GT. 0 ) IVLs IVL ♦ <VCH*l>/2 — 

<0066) CALL HOVAOSf IHL* IVL ) 

. <0067) CALL AOUTSTC NVLAPl* VLABLl ) _ 

<0068) IF < NVLAB2 .EO. 0 ) GO TO 200 

, <0069) IHL= HAXC< C* HU'L «VOFF -L IMWD T <K.N VL AB )-VCH/ 2-2 . 

<0070) IVL= IVL - VCH-2 

i <0071) CALL KOVABS< IHL* IVL ) 

<0072) CALL AO0TST< NVI.AB2* VLAPL2 ) 

; <0073) IF < NVLAB2 .EG. 0 ) GO TO 200 ... 

<0074) IHL= MAX0< 0* H WL-» VO FF -L INUD T < FN VLAB ) - VCH/ 2-2 ) 

<0075) IVL= IVL - VCH-2 

<0076) CALL HOVABSC IHL* IVL ) 

<0077) CALL ACUTSU NVLAB3* VLABL3 .) . - 

i I <0078) C 

i , <0079) C DECLARE OFFSETS AND CRAW LOWER AND LEFT SIDE AXES, 

<0080) C DSPLAY ALSO LABELS TIC HARKS. 

<0081) C ..... . 

. <0082) 200 CALL XLOC( HOFF ) 

. <0083) CALL YLOC< VOFF ) ~ - 

• <0084) CALL CHECK( 0* 0 ) 

(0085) CALL DSPLAY< 0* 0 ) ... . . 

I <0086) C 

(0087) C DECLARE OFFSETS FOR TOP AND RIGHT SIDE AXES AND DRAW THEH. 
(0088) C 

(0089) CALL XLOCTPi -HOFF ) • 

(0090) • CALL YLOCRT< -VOFF ) 

, . (0091) CALL CHLCKI C* 0 ) 

(0092) CALL GRID 

(0093) C _ 

(0094) RETURN 

(0095) END - - . 

PROGRAM size: PROCEDURE - 000541 LINKAGE - 000124 STACK - 000102 

. 0000 ERRORS C<AXES >F TN-REV15.3 3 — — 


I 

I 





SUOROUTINC CFBLK t HPDt VPB ) 


(0096) 

(0097) 

(009B) 

(0099) 

( 0100 ) 

( 0101 ) 

( 0102 ) 

(0103) 

( 0100 ) 

(0105) 

(0106) 

(0106) 

(0106) 

(0107) 

(0106) 

(0109) 

( 0110 ) 

(Bill) 

( 0112 ) 

(0113) 

(0114) 

(0115) 

(0116) 

(0117) 

(0118) 

(0119) 

( 0120 ) 

( 0121 ) 

PROGRAM 


SUBROUTINE GPDLK ( HFB« VPB ) 
PUTS PARAMETER BLOCK ON PLOT. 


HP6 

( INPUT) 

HORIZONTAL RASTER COORDINATE 

CORNER. ■ - ■ ■ - -* •• 

INTEGER HPB 

OF UPPER LEFT 

VPB 

(INPUT) 

VERTICAL RASTER COORDINATE OF 
INTEGER VPB 

UPPER LEFT CORNER 

COMMON 

BLOCKS 

(SEE I NIT 

FOP COCUMENTATICN 


180 


200 


IHPB= HPE - 

IVPe= VPB 

DO 200 1PBL=1.NPBL 

1VPB= I VPB- LlNHGT(l)- 2 - 

IF ( IVPD .GE. C ) CO TO 180 
IHPB= IHPIH LINUDT(NPBCH*5) 

1VP0= VPB- LINHGTU)- ? 

CALL MOVABS( IHPBt IVPD ) 

CALL AOUTST( NPliCHt POLK(l.irEL) ) 
CONTINUr . . - . 


RETURN 
END 

size: PRCCfnURF - 000132 

0000 ERRORS CCGPRLK >FTN-REV15.3D 


LINK AGE 


000044 


STACK 


000022 


SUOROUTINC-CPHCON 


c4>oo 1 ) su,'UUMn-wjE:_aP4<c«»i 

(C002> C 

40005> -C-CONT«OLS GRAPHICAL-OUTPUT,— ^ 

(OOOA) C 

«0 005>— -C 

(0005) C COKHON BLOCKS (SEC INIT FOR DOCUPCNTATir 


(0006) C LOCAL DECLARATIONS 

—40007) — RCAL-“MSFL(?rl),- HSPH)! 

' (0008) EOUIVALCNCC (SCK1*HSFL) 

-(GOOS) — DIMENSlON-iJLPBd) — 

(0010) EOUIVALEKCE (SCRlvBLPR) 

(O^OM > MJ-TCOE-R-tSG^E ^ 

(0012) DIMENSION PROFS(IC) 

( 0 0 1 i ) ai P r N s I c n^-i r sp ( 1 1 — - - 

: (001<») INTEGER ALINEd) 

(GOIK) EQUIVALENCE— ISCR5»AL-INC-)*^-(SCR2,IRSF) 

(0016) DATA PROFS / 0.* .1« .Sf .9* l.t 5*0. /• NPROFS /5/ 

— (QQ17.) C 

' (0018) C SET UP ALPHANUMtRIC BLOCK OF PARAMETER VALUES FOR GRAPHICAL OUTPUT. 

— ^ — (0-015) — C 

! (0020) NPBL= 6 

_4 — (4)021) NPBCH= — ,‘U-NCW 


( 0022 ) 

-4.04)23)- 

(0024) 

-(4)025). 

(0026) 


ENCODE! NPDCH« 220, ALINE ) DXM 

2 20 — f-OJi HAT-t— GHXUTJtE— ,-F_5-..l C M 6 >-). 

CALL SETHOL( PBLK(1,1), NPPCH, ALINE ) 

EJICO CE ( -NP BCH,-23C , ™ AL TNE - DV M 

230 FORMAT! 2HL=, F5.1, 3H CP, 1 OX ) 

027) CALL-..SE-THOL(-P4HLK(l,2) , -NPFCH, ALINE )• 

(0028) ENCODE! NFPCH, 240, ALINE ) GAMMA 

9 ) 2 4 0 F-O.^M A.TJ— £ HC.A A-,— 1 C9 .42-,.-.SJt.-) 

(0030 CALL SETHOL! PBLK(1,3>, NPE^CH, ALINE ) 

(0031) ENCODE!. NRPCH,-250, -ALINE— I- OTDX 

(0032) 250 FOKMATC 2HG=, F7.2, 9H DEG C/CM, 2X ) 

L0033) CAlL-SE-lHOL(-RnLK(l,.A),-NPnCH,. ALINt J. 

(0034) ENCODE! NPBCP, 260, ALINE > CTCTM 


-(4I035J 2S0 F-OaHA-l.(—4HCP-S^_F-7 .3-,- P-H-T.E 6/ S EC, IX. 


(0036) 
-(4)037)- 
(0038) 
(0039). 
(0040) 
-(.04)41)- 
(0042) 
-60 04 3). 
(0044) 
-(0C45) 
(0046) 
-iJl-04 7)- 
(0048) 
-1004 9 
(0050) 
-40 051). 
(0052) 
-40-053)- 
(0054) 
.(0055). 
(0056) 
..(0057). 
(0058) 


270 


CALL SEThOLl PBLK(1,5), NPI:CP, ALINE ) 

-ENCODE l-NPaCK,-270,-ALINE -) GFCBCE 

FORMAT! EHGPAVITYs, F6.2, 2H G, 4X ) 
-CALL-SEJHOL(-P.aLK.(l,6) ,_NP.BCK,.. ALINE-) 


-500 XALL.NfWFAG 

WRITE <CRT,FMT80) TITLE 

UR IXE- (CRT ,510 ) 

510 FORMAT! // 21H FUNCTION TO 

, 14M G4.0T_T.V.nC.,— . 


PLOT, 29X, 


// 


36H 

i2H- 


13H 

-24H- 

19H 

-UH- 


/ 

-/- 


3 4H 
-24)H. 


14H 

.3.6H- 


6 

-Z. 


FINAL LOCAL AVERAGE COMPOSITION, 14X, 

.VERTICAL FRCriLES, 

VELOCITY, 37X, 

HCR120NTAL FRCFILES, 

pressure: p-fo, six, 

-VECJOR-FIELD, 

PRESSURE - BULK HYDROSTATIC P, 16X, 

-F.RACT ION .LIQUID, .30X, 

MASS FLOW, 3fX, 

-SCLUTE-FLOU, 34X...J 


530 WRITE (CRT, 535) 




ORIGINAL PAGE IS 
OF POOR QUALrrY 



I (0060) 
_J — (0061)^ 

I (0062) 

— ; — (0063) 

! (0064) 

-J — tC0651- 


IJXH-WUXBrJi.-O^_^:llNCI.^0^^~t0..FLC^ t ORt 
» / 19H P TO PROCLtO. ) 

-4-RGP C l )-4h 

READ <CRTtFMA4,EPR=540) IRSP 


„XF- (IRRPdT^ECl.^HP 
IF (IRSP (D.EO.AH 


*BETURR. 

GO TO SAC 


-DIXOOE- 


(0066) 
-to 067) 


I 


(006B) 

-to 06*3 1 . 

(0070) 

-i4J07U- 


I (0072) 
_a_|4)073). 

' (0074) 

- J -- C0 075) 

• (0076) 


IF ( ITXF.GT.O 

.„5^40 — RR IT E~tCRT,Fi;T5> 

GO TC 530 

,.-55iJ— .W(U.IE_tXK T ♦5.5S7. 

555 FORXAK / 30HENTER 

R£iU_tCRI-» A * 4 ; R Rr^CtU). 

IF ( ITHP.GT.C .AND. 

-5 60 — WR I-T E- C CRT^F MT-5 » 

GO TO 55C 


IJlS^P*_r RR=5 40-)— 1-THF— 
.AND. ITHF.LT.e ) GO TO 


550 


ITEF 

-ITf-F. 

ITMP 


RUFEFR OF PLOT TYPE ) 


LT.4 ) GO TO 570 


— C0077)- 
(0076) 
— 10079). 
' (0080) 
— 10081) 
(0062) 
— too 81)- 


570 GO TC (600t700.i’00«650f500.100r«110C)« 

. „5AO F-OR HA T— 1-2 JH L-I D- ^ICL-E C T 1 0 N- ) - 

C 

C FLOT-F-IN AL ..COHF01I7 I ON 

C 

... 600 - -GO -TO -1-620. ..61 0-.-61C— ) 

610 WRITE (CRT. 590) 

.XC- S3ii 


ITMF 


-GD- 


I 


(0084) 
-(O085J-. 
(0086) 
.(0 087).. 
(0088) 
-to 083).. 


620 


625 


(0090) 
-to 091). 
(0092) 


CMAX= -RINF 

-.CHlNs.RXNF- .... 

DO 625 J=1«NJ 
..X.8AX = .AHA X 1 ( -CHAX 
CH1N= AFINK CMIN. 

AXXC_CKA.X-“OUO. .-CL-t ^ CH I N , . 2 


.A vest J). 
AVCS(J) 


) 

) 


CALL SCALE( CLO-CIF. CLO^DIF* SCNINt SCMAX ♦ NSI , ESCALE ) 


-60093) 
(0094) 
_t0O95)_ 
(0096) 
-to 097). 
(0098) 

-to 095). 
( 0100 ) 
.6JJ101). 


-630- 


CALL NEWPAG 
..OMIN= SCMIJl- 
OMAX= SCMAX 


635 


_URXT.L-tCR-l.635J. -CHI H. ALN AM ( P) C M A X . ALN AM ( 2 ) * SC F 
FORMAT( 22HHIN1MUM COMPO.S 1 T ION IS. F6.2. 8H WT. 
/ — 22HMAXIMUK-CCMPOSITION IS. F6.2* f.H UT 

* ///37HAUT0MATIC SCALING YIELDS PLOT RANG.-T: 

-A F6..2.* 

* ///45HENTER P TO FRCCEEC WITH AUTOMATIC SC 


IN. 
PC 1 
PCT 

. 


SCMAX 

• » A A » 

• * A4 . 


TO. 


-35.H. 


6-CU CP.-E CU N D -C F- „P L C .T - 4N T C R V A L . 


ALIRG. OR. 
) . 


( 0102 ) 

-t0103). 

(0104) 

.60105) 

(0106) 

60107.X 


.639- 


(0108) 
..CO 109). 
(011^) 
-CO 111). 
(0112) 
-t0113X 
(0114) 

-tons) 


00 639 11=1.20 

..JRSP,(IU = ..4H 

READ (CRT«640.ERR=645> IRSP 

6.40 FCRHAT I-20A4 . J_ 

IF ( IRSP(l). E(3.4HP ) GO TO 655 

LE_( mSittU . EO . .46 1-GtX-T £l_6.4S- 

DECODEC HO. *. IRSP, ERR=645 ) CMIN 


— GO-jr 0-65.0. 

645 WRITE (CRT.FMT5) 
GO Xa-63C 


659 


WRITE (CRT. 655) 

-F-OR-MAI-Lt 25MEN.TEIL_U6RER_£0UNIX.0E-6LCT.4NTERVAL. 

DO 659 11=1,23 

-IRSP HU = -4M — 


■- i 


(0116) 
-to 117). 
(0118) 


read (CPT.64 C.C".R = 665) IRSP 

LF_Uil6P_ll) .EO .4H X..C 0-10-665 

DECODE( eC« «• IRSP* ERR=665 ) CMAX 






SUURCUTINe~&PHCO*^ 


j _J — U4494 lF_4XIU.X«lC^-CM44t)_C*~WJ-44.S 

! * C0120) SCMlKr OHIN 

i «0121> -SCHAXs-OHAK- 

' (0122) GO TO f.95 

, _l_«0123) 6M — VRI4C— <CRTtF#«T5-> - 

(012A> CO TO 650 

(-0-1254 C 

1 , (0126) 695 CALL VPRCFS* lOUM* CUH» SCPlNf SCHAX* NSIt -ESCALEt 

— : — (0127) • RVC-Si"l»-l* jClPf Of - 

• (0128) • 32* 32HFINAL LOCAL AVERAGE COMPOSITION « 

L0129) • l^r-16)V (WT-PCT- SOLUTE) - )- 

; (0130) GO TO 500 

— : (0-1-314 G : 

• (0132) C PLOT VELOCITY 

(-0133) — C 

! (0134) 700 CO TC ( 710* 71Ct 740 )« ITMP 

_j — (0135 N 410 — yR4-TE-(CRT-r5^0^> 

(0136) GO TO 530 

-l-. ( . 0-1 3^74 7-40 — VH4X-S-0, 

< (0138) DO 745 J=ltNU 

— : — (0139) DO— 7A5--I-=-l-»!V-I 

' (0X40) 745 VMAX= AMAXK VM«Xf V < 1 ♦ 1 1 J ) * * 2-* V ( 2t I * J ) ** 2 ) 

— (0141) VKAX= -SORt-(_VNAX— ) - — 

I (0142) CALL VECFLT( VMAX, V« 2t ICIMt oniM* C« 

_i™4 0l43> * 14^_4-fe.KA»€-L-()C4-TY— F IE-L-O r-&r~8H( G-H/SEC ) ) • 


' (0144) GO TO 500 

: — (-0145) — c — 

: (0146) C PLOT PRESSURE (P-PO) 

(0147-) — C 

(0148) SOO p'hAXs -PINF 

J — to L45J aai u s J U .N4 

(0150) ■ DO 805 U=ltNU 

(0151) 00-AC5-I=l*M 

(0152) BLPR (M(J-l) *NI )= P(I-H»J*1)^ PPL ( N 1 « U) *GR AV ^ ( Y ( N J ) - Y ( J ) ) 

-! — (0153) pj(AX=-AMAXll-FMA.X*-CLPR(l'»(J-l)».NI) ) - 

(0154) PHIN= APINK PMIN* PLPR ( I ■» ( J-1 > *NI ) ) 

: — (4)1551 BO-5 COW-T-INUE - 

(0156) CALL SCALE ( PMINt PMAX* SCKIN* SCMAX« NSIt ESCALE ) 

- — (0157) GO— TC_(-e23»—8A0-t_ai.C-)-i— LIMP — - 

(0158) 810 WRITE (CRTtr.90) 

J — (0159.) GO_XC_530 : . 

I (0160) 820 CALL VPROFS( NPROFSt FROFSt SCMINt SCMAXt NSIt -ESCALEt 

J — (0-1614 * BL£IU-1 -Nl.*-NJ»-Ct — - 

I (0162) * 16t 16HPRESSLIRE: (P-FO)t 

^ — (0163) — * 16.*_16H (DYJJE5/CM *•?)—) — . 

(0164) GO TC 500 

(0165). R40 CALL-HP.RCF-S(_NRRCF.S* -PROFS,. SCKIN, SCHAXt- NSI t . -ESCALF.t 


(0166) • BLFRt It Nit NJt Ot 

(4116-74 • 16» 16HF RESSURE. . (F - F. 04 « 

(0168) • 16t 16H(DYNES/CM«*2) ) 

^(0169) GO. -TO -500 

(0170) C 

- C0171) — C- FLOJ_RR£SSURE_-i_£ULK-H.YCROSTATIC.FRESSURE. — 

’ (0172) C 

J (01X3 ) 850 EHAXs -r.JUME 

' (0174) PM1N= PINF 

J L017S) D0_E55_J = ltNJ 

' (0176) DO 855 l=ltNl 

J (0177) ERJlXs-AKAXK-P.FUXt- P (I-*l,Jtl ) ). 

(0178) PHlNs AKINK PKlNt P(I-*ltJ*l) ) 




^UQRCUT INC-CRHCOR 




-ass — cauj-uuitr- 


{Oiao> 

-4ai8i>- 

( 0182 ) 

■ 40183 )- 


660 


cm SCALE ( PMIN* PMAXt 
-T-0-(— R7 0 ♦ • -89^0 t-86-C -) ♦ - 
WRITE (CRT«5S0) 

-ftO- T-C-5-3^> 


SCMIN, 
ITHP 


SCHAXt ^SIf ESCALE > 


I ( 0184 ) 

~J — (44 8 &)-. 

! ( 0186 ) 
— : — (-0184 
i ( 0188 ) 
_! — L 0489 ).-. 

I ( 0190 ) 
_i — (. 81914 - 


870 CALL VPRCFSI 


NPBOFS* PROFS. SCPIN. SCMAX. 

4V-1-,_LC-LM«.?.»-.^CIK«2.- 1 « 

32 . 32 HFRFSSURE - HULK PVCROSTATIC 
-14^ RH (OTNES/CR**24 - ) 


NSI. -ESCALE. 

P . 


-asjj- 


( 0192 ) 
-( 4193 ) . 
( 0194 ) 
_(-ai 95 )- 
( 0196 ) 
-( 41197 )- 
( 0198 ) 
- 40199 ). 
(0200) 
-402014 
(0202) 
. 40403 )- 


CO TO fiOO 

-X ALI HBEXFS.4-ICP-K.0ES-. -P R 0 F S. - SC H I JC>-S CM 4X .— WSJ .--ESCALE. 

* P. 1 . ICIH 42 . ODIK« 2 . 1 . 

_t S2.^32>lEESSSURE--..rtULK-KyDR0STA.TIC P - 

• 16 . 16 H(CVKES/Cf'** 2 ) ) 

..-60.- T 0 - 504) — 


. C-PLat-V 0 UJHt-F-E ACJ lOW-L I X L I 0-. 
C 

. — SoO — CO — TO — ( — S2-0-. — - 9 4 0 -. ■ ■ 8-1-0 — )-i 
910 WRITE (CRT.S90) 

CC-TC- -530 


-I4MP- 


920 CALL VPRCFSI 




NPROFS. PROFS. 0 .. 1 .. ! 
OL^-l.-IOIM.—iClK* 0 . - . 
24 . 24 H VCLtWE FRACTION 


0 . 


uKUIC . 0 . NL'LL ) 


I ( 0204 ) 

— ; — 40205 )—- 
( 0206 ) 


940 CALL HPROFSC 


1 


NPROFS. PROFS* 0 .* 1 *. ! 
XL»— 1 ,-- 1 XIH* JOIN. C.-- 
24 . 24 H VOLUME FRACTION 


LIQUID « 0 . NULL > 


i 


0.0207.1 — 
( 0208 ) ( 
_tX 2054 — ) 


-C C ..T C-SXfl- 


SASS-SLDS- 


( 0210 ) 

- 40211 ). 

( 0212 ) 

-(0213)- 

( 0214 ) 

-402154- 


-4 000 . 
1010 


1020 


CO-TO - 4 -4414 0 .--401 O*_ 4 . 0 2 X - 4 ^ - 
WRITE (CRT. 590 ) 

Sa-X 0.-53 c 

MSFNXs C. 

X 0 - 4 -a 2 S. ySl.NJ 


ITMP- 


( 0216 ) 

- 40247 )— 


DO 1 C 2 S 1 = 1 . NI 
_ 1 M. 5 lX *.4 J-- 4 ).^ N I_ 


( 0216 ) 

J 40219 )- 

( 0220 ) 
- 402214 - 
( 0222 ) 
- 40223 )- 
( 0224 ) 
- 40225 ).- 
( 0226 ) 
-4-02274- 
( 0228 ) 
- 40229 )- 
( 0230 ) 
-to 231 )- 
( 0232 ) 
- 40233 )- 
( 0234 ) 
- 402351 . 
( 0236 ) 
- 102371 - 


MSFL (1 .IM>= RHL (I.J) *GL( I. J) *V( 1 . I. J) 

.f'.SELt 2 .lM- 4 =-RHL- 4 I.J.J*GL(I.J) •Vta.I.U) 

MSFMX= A“AX 1 < MSFMX. MSFL ( 1 « 1 M > * * 2 *M SFL ( 2 . I M ) * *2 


-4025--CCW14NUL- 


MSFMX= SGRT( 
XALL .VECP-LJ 4 - 


MSFMK ) 

.MSFKX._MSrL, . 2 , NI. .NJ. 0 .-. 
12 . 12 HRASS FLOW * 
X. 0 .._ 2 aa(_.GH /_4 S EC*-. CM* * 2 ) ...) 


GO TO 500 


SOLUTE FLOW 


1100 GO TO ( 1110 . 1110 * 

me. WRnC_ 4 CRI. 590 ) 

GO TO 530 

CS_0- 

DO 1125 J= 1 ,NJ 
_aO__L 125 _l-l . WJ 


1120 )* ITMP 


( 0238 ) 


IH=I*(J- 1 »*NI 
-HSE.L t 4 U-K 4 =_. 0 X*_ 
MSFLI 2 . 1 M)= . 01 * 


.CL. 44 . JJ.*-KHLtI .J 1 *-GL 4 I.J ) * 
CL( 1 . 0 >* RHL(I.J)* CL( 1 .J»« 


■V(l.l.J) 
VC2.I .0) 








SUOROUTINC HPROrS ( NPRFt PRFt AKIN* AHAX* NATCS* ASCALC* 


C0336) 

(0337) 

(0338) 

(0339) 

(0340) 

(0341) 

(0342) 

(0343) 

(0344) 

(0345) 

(0346) 

(0347) 

(0348) 

(0349) 

(0350) 

(0351) 

(0352) 

(0353) 

(0354) 

(0355) 

(0356) 

(0357) 

(0358) 

(0359) 

10360) 

(0361) 

(0362) 

(0363) 

(0364) 

(0365) 

(0366) 

(0366) 

(0366) 

(0367) 

(0368) 

(0369) 

(0370) 

(0371) 

(0372) 

(0373) 

(0374) 

(0375) 

(0376) 

(0377) 

(0378) 

(0379) 

(0380) 

(0381) 

(0382) 

(0383) 

(0384) 

(0385) 

(0386) 

(0387) 

(0388) 

(0389) 

(0390) 

(0391) 

(0392) 

(0393) 


SUBROUTINE 


C 

C PLOTS SELECTED 
C 

C 

C NPRF < 

C PRF ( 

C 

C - . 

C AKIN ( 

C ^ 

C AHAX ( 

C 

C NATCS < 

C ASCALE ( 

C 

C ARRAY ( 

C N1«N2*N3 ( 

C IJE ( 

C NC ( 

C NAME ( 

C NCU ( 

C NAHEL ( 


HPROFS ( 


NPRF* PRF* 
ARRAY* Nl* 
NCU* NAKEU 


AKIN* AHAX* NATCS* ASCALE* 
N2* N3* IJE* NC* NAPE* 


HORIZONTAL PROFILES OF ARRAY. 


INPUT) NUMBER CF PROFILES TO PLOT. 

INPUT) YY VALUES OF PFCFILES TO PLOT. 

WILL INTEFPCLAIF LINEARLY TO VALUES BETWEEN 

. . .TABULATED VALUES OF YY. 

DIMENSION PRF(NPRK) 

INPUT) MINIMUM VALUE ON HORIZONTAL AXIS (SCALED 
BY 10**ASCALE). 

INPUT) MAXIMUM VALUE ON HORIZONTAL AXIS (SCALED 
BY 10**ASCALE>. 

INPUT) NUMBER CF TIC SPACES CN HORIZCNTAL AXIS. 
INPUT) SCALE FACTOR FOR PLOTTING WILL HE 

1C**ASCALE. 

INTEGER ASCALE 

INPUT) ARRAY TO PLOT. 

DIMENSION ARRAY(NltN2*N3) 

INPUT) DIKENSICNS CF ARRAY. 

INPUT) EXPANDED Mf SH INDICATOR. SEE PSOLVE. 

INPUT) NUMBER OF CHARACTERS IN NAME CF ARRAY. 
INPUT) NAME OF ARRAY -USED TO LABEL VERTICAL AXIS. 
DIMENSION NAME(NC) 

INPUT) NUMBER OF CHARACTERS IN ARRAY UMTS. 

INPUT) ARRAY UNITS - USED TO LABEL VERTICAL AXIS. 
OIMENSICN NAMFU(NCU) 


C 

C COMMON BLOCKS (SEE IMT FOR DOCUMENT AT ICN 

C : 

C LOCAL DECLARATIONS 

DIMENSION APRF( 1) 

EOUIVALENCE (SCF2,APRF) 

DIMENSION LABEL(l) . , 

EQUIVALFNCE (SCR2. LABEL) 

DIMENSION LABSCL(3) . 

INTEGER HK« VK » HPB. VPB 

INTEGER FAT(6) 

DATA PAT / 11* 56* 34* 12* 3212. 321212 / 


C 

C 

C INITIALIZE PLOT. PUT ON LABELS AND TITLES. AND DRAW AXES. 

C LABEL WILL CONTAIN THE NAME CF ARRAY. THE SCALE FACTOR. IF 

C ANY. AND THE UNITS OF ARRAY. . 

C GPPLK PUTS CN THE PARAMETER BLOCK. 

CALL SETPLTt 0. 24* 24H HORIZONTAL PROFILES CF . NC. NAME ) 

HPB= HWP*VCH«HCH 

VPD= VUU- ( VW-NPDL*( VCH<»2))/2 .. . 

CALL GFBLKI HPB. VPB ) 

NCL= 12 

ENCODE ( NCL. 210. LABSCL ) ASCALE 

IF < ASCALE. EQ.C ) NCL= 0 

210 FORMAT ( 7H X 10*** 13. 2X ) 

C 




;j«iginal paop k 

OF Pnr,T> ^ IS 

^OOR QUALITY 


SUBROUTINE HPROFS t NPRF« PRF* APlNf APAKt NATCSt ASCALC* 


<0394) 

<0395) 

<0396) 

<0397) 

<0396) 

<0399) 

<0400) 

<0401) 

<0402) 

<0403) 

<0404) 

<0405) 

<0406) 

<0407) 

<0408) 

<0409) 

<0410) 

<0411) 

<0412) 

<0413) 

<0414) 

<0415) 

<0416) 

<0417) 

<0418) 

<0419) 

<0420) 

<0421) 

<0422) 

<0423) 

<0424) 

<0425) 

<0426) 

<0427) 

<0428) 

<0429) 

<0430) 

<0431) 

<0432) 

<0433) 

<0434) 

<0435) 

<0436) 

<0437) 

<0438) 

<0439) 

<0440) 

<0441) 

<0442) 

<0443) 

(0444) 

<0445) 

<0446) 

(0447) 

<0448) 

<0449) 

(0450) 

(0451) 

(0452) 

(0453) 


CALL AXrS< 


0«t 0*5t~ — 
AH1N« AMAXf 0* NATCS* 
NCU« NAMEU ) 


-2t 16f 16H-(X-XC)/(XL-XE) 
2t NC« NAPE* NCL* LABSCL* 


C 

C 

C 


SET PLOT VARIABLES FOR CLRVES. 


CALL NPTS< N1 ) 
CALL OUINDO( 0.« 


l.« APIN/dO. **ASCALE) t A HA X/( 1 0 • > * ASC ALE ) ) 


IF (N2.EQ*1) GO TO SCO 
INITIALIZE OF LINE PATTERN KEY BLOCK. 


LKL= t:\ 

LKT= L!<L*LINWDT(12) 

VK= VUL-3*VCH-3-2*VCH 
NKB= NPRF/ (VK/(VCH*2)) 

IF ( (VK/(VCH^2) )*NKB .LT 
HK= LINWPT( HAX0(24«NC) * 
HK= HAX3( HK« 

IHK= HK 
IVK= VK*VCH*2 


NPRF ) NKB= NKB^l 
HSCRN- NKE»LKT- ( NKB-1 ) *L INW DT ( 5) 


C 

c 

c 

c 

c 

c 


LOOP THROUGH PROFILES. 
DO 480 1PRF=1«NPRF 
LOCATE EACH PRF 


IN YY* INTERPOLATE TO PRF. AND PLOT CURVE 


320 


340 


360 


DO 320 J=2«NJ 
IF ( PRF(IPRF) 
J=NJ 


.LT. YY(J) ) GO TO 340 


FACT= (PRF(IPRF)-YY(J-D) / (YY (0 )-YY(J-l ) ) 

DC 360 1 = 1 *N I • - 

APRF(I)= ARRAYd* I-»IJE*U^1JE-1)» 

FACT*( ARRAY(l.I*10Ef J*UE)-ARRAY(1*I*IUE.J*IJE-1) ) 

CONTINUE 

IPAT= PAT( M0D(1PRF45*6)^1 ) 

CALL LINE( IPAT ) i - - - 

CALL CPLOT( XX* APRF ) 


C 

C 

C 


420 


LABEL LINE PATTERN 
IVK= IVK-VCH-2 

IF (IVK.GE.O) GO TO 420 - 

1VK= VK 

IPK= IHK-»LKT4LINU'CT(5) — 

IF ( IHK4LKT .GT. HSCRN ) GO TO 4P0 
CALL HOVAPS ( IHK* I V K4 ( V CH+? ) /3 ) 
CALL DSHABS( IHK-»LKL* I VK4( VCH^Z) /3* 
CALL MOVAOS( IHK^LKL* 

IF (IVK.rCJ.VK) ENCODE! 

IF (IVK.LT.VK) ENCODE! 


IPAT ) 


430 

440 


FORMAT! 6H Y/L =* F6.3 
FORMAT! fX* Ft. 3 
CALL AOUTST! 12* LABEL 


IVK ) 

12* 430* 
12* 440* 
) 

) 

) 


LABEL 

LABEL 


PRF( IFRF) 
PRF(IFNF) 


480 CONTINUE 




SUQROUTINC HPROFS ( NPRF« PRFt AHIN* ARAXt NATCSt ASCALC« 


C0454) 

<0455) 

<0456) 

<0457) 

<0458) 

<0459) 

<0460) 

<0461) 

<0462) 

<0463) 

<0464) 

<0465) 

<0466) 

<0467) 

<0468) 

<0469) 

PROGRAM 


CO TO 600 

PLOT SINGLY DIHFNSICNCD ARRAY. 
500 CALL CPLOTt XX« ARRAY ) 


FLUSH PLOT 
RCSPONSL. 


C 

c 
c 

I 

c 
c 
c 
c 

600 CALL MOVABSl 
CALL ANMOOE 
CALL UAIT 
RETURN ^ 

C . . 

END 

size: procedure - 


DUFFER* RETURN TO ALPHANUMERIC MODE* AND bAIT FCR OPERA 


0* VSCRN ) 


0D1263 


LINKAGE • 000212 


STACK - 000102 


0000 ERRORS C<HPROFS>FTN-REV15.33 


SUBROUTINE SCALE ( FHIN« FHAX* SCMINt SCNAXt NSIt ESCALC > 


(0470) 

(0471) 

(0472) 

(0473) 

(0474) 

(0475) 

(0476) 

(0477) 

(0476) 

(0479) 

(0480) 

(0481) 

(0482) 

(0483) 

(0484) 

(0485) 

(0486) 

(0487) 

(0488) 

(0489) 

(0490) 

(0491) 

(0492) 

(0493) 

(0494) 

(0495) 

(0496) 

(0497) 

(0498) 

(0499) 

(0500) 

(0501) 

(0502) 

(0503) 

(0504) 

(0505) 

(0506) 

(0507) 

(0508) 

(0509) 

(0510) 

(0511) 

(0512) 

(0513) 

(0514) 

(0515) 

(0516) 

(0517) 

(0518) 

(0519) 

(0520) 

(0521) 

(0522) 

(0523) 

(0524) 

(0525) 

(0526) 

(0527) 

(0528) 

(0529) 


C 

c 

c 

c- 

c 

c 

c 

c 

c 

c 

r 

c- 

c 

c- 

c 

c 

c 


SUORCUTIKE SCALE ( FFlNt FMAXt SCMIN* SCMAXt NSIf ESCALE ) 
CALCULATE AFFRCFRlATE PLCT SCALE FCR FUNCTION* - -• 


FMIN 

(INPUT) 

MINIMUM 

OF FUNCTION TO 

SCALE. 

FMAX 

(INPUT) 

MAXIMUM 

OF FUNCTION TO 

SCALE. 

SCMIN 

(OUTPUT) 

H INIMUM 

SCALE VALUE. 



SCMAX 

(OUTPUT) 

MAXIMUM 

SCALE VALUE. 



NSI 

(OUTPUT) 

NUMBER 

OF TIC INTERVALS 

ON 

SCALE BETWEEN 



SCMAX AND SCMIN. 



ESCALE 

(OUTPUT) 

SCALE VALLES MULTIFLIEO 

BY 

10**-ESCALE. 



INTEGER 

ESCALE 




LOCAL CECLARATICNS 
INTEGER EX 


DETERMINE REMOTE EXPONENT* IF-ANY* 


C 

C 

c 


SCHIN=0. 

SCMAX= 0. 

NSI= 0 

ESCALE= 0 

AHAXF= AMAXK ADS ( FM IN) * - ABS ( FM AX ) - ) 

IF ( AHAXF.EG.O. ) RETLRN 
ESCALF= IFIX( ALOGin(A^’AXF) ) 

IF ( ALCG10(AMAXF)-FLOAT(ESCALE) .RT. 
IF ( lABS(ESCALE) .LE* 2 ) ESCALE= 0 

determine tic interval. 


."99 > ESCALE= ESCALE*! 


AOIFFs ABS( FMAX-FHIN ) 

IF (ADIFF.EO.O. ) RETLRN 

FLOGS ALOGIO ( ADIFF ) - 

EXs IFIX( FLOG ) 

IF ( FLOG .LT. 0. ) EXs EX-1 
WHS ADIFF* 10.**(-EX) 

DELsl, 

IF ( WH .LT. 4.5 ) DELS .5 

IF ( WH .LT. 2. ) DELS ,2 

IF ( WH .LT. 1.2 ) DELS .1 




C 

C 

c 

c 


DETERMINE SCALE MAXIMUM AND MINIMUM. 
AVO'ID CLIPPING AT EXTREMES. - _ - 

SMINs FMIN* 10.**(-EX) 

NMINs 1ABS( IFIX(SMIN/DEL) ) 

IF ( ( SKIN .GT. 0. ) .AND. 

* ( SMIN-FLOftT(NMIN)*DEL 
IF ( ( SKIN .LT. 0. ) .AND. 

• (-SHIN-FL0AT(NM1N)*DEL 
FMAX* 10.**(-rX) 

1ABS( IFIX(SM AX/CEL) ) 

( SMAX .GT. 0. ) .AND. 

( SMAX-FLOAT(NMAX)*CEL .GT, 

( SMAX .LT. 0. > .AND. 
(-SMAX-FLOAT (NHAX) .DEL .GT. 


•GT. .99*DEL ) ) NKIN= NMIN*1 
.GT. .01*DEL ) ) NMINs NMIN*1 


NHAXs NMAX*1 


SMAXs 
NHAXs 
IF ( 

.01*CEL ) ) 

IF ( 

• (-SMAX-FLOAT (NHAX) .DEL .GT. .99. DEL ) ) NMAXs NMAX*1 

SCMINs SIGN( 1,,THIN)« FLCAT(NMIN). DEL* 1 0 . * * (E X-E EC ALE ) 
SCHAXs SIGN( 1. »FKAX ) * FLOAT(NMAX)* DEL* 1 0 . * * (E X-E EC ALE ) 


SUBRCUTINC SCALE I FRIN* FMAXt SCKIN* SCHAXt NSI« CSCALE ) 


(0530) NSIs IAOS( NHAX* IFIXC -SICNd .•FH1M*FMAX) ).* NMIN ) . - 

(0531) C 

(0532) RETURN — - - 

(0533) END 

PROGRAM size: procedure • 000600 LINKAGE - 000056 STACK - 300046 

0000 ERRORS ECSCALL >FTN-K EV15.33 




C0534) 

(0535) 

(0536) 

(0537) 

(053B) 

(0539) 

(0540) 

(0541) 

(0542) 

(0543) 

(0544) 

(0545) 

(0546) 

(0547) 

(0548) 

(0548) 

(0548) 

(0549) 

(0550) 

(0551) 

(0552) 

(0553) 

(0554) 

(0555) 

(0556) 

(0557) 

(0558) 

(0559) 

(0560) 

(0561) 

(0562) 

(0563) 

(0564) 

(0565) 

(0566) 

(0567) 

(0568) 

(0569) 

(0570) 

(0571) 

(0572) 

(0573) 

(0574) 

(0575) 

(0576) 

(0577) 

(0578) 

(0579) 

(0580) 

(0581) 

(0582) 

(0583) 

(0584) 

(0585) 

(0586) 

(0587) 

(0588) 

(0589) 

(0590) 

(0591) 


SUOROUTINC S5TPLT ( HOFF* NCLAPl* LAPCLl* NCLAP2* LAREL2 ) 


C 

C 

C 

C 

C 

C 

C 

C 


SUBROUTiriC SETPLT ( HOFF * NCL ABl « • L ABEL 1* - NCL AD 2 * L ABC(,2 ) 
INITIALIZE PLOT AND PUT ON PLOT LABEL. 


HOFF 

(INPUT) 

VERTICAL OFFSET OF HORIZONTAL 
RASTER UNITS, -• •" 

INTEGER HOFF 

AXIS 

FROM VWL. 

NCLABl 

LABELl 

(INPUT) 

(INPUT) 

NUMBER OF CHARACTERS IN PLOT 
PLOT LABEL 1 (ALPHANUMERIC). 
DIMENSICN LARELl(NCLABl) 

LABEL 

1. 

NCLAB2 

LABEL2 

(INPUT) 

(INPUT) 

number of CHARACTERS IN PLOT 
PLOT LABEL 2 (ALPHANUMERIC). 
DIMENSICN LABEL2(NCLAB2) 

LABEL 

2. 


COUPON BLOCKS 


(SEE INIT FOR OOCUHEN T ATI CN 


CLEAR SCREEN AND INITIALIZE PLOT CCPHON AREA 


CALL NEWPAG 
CALL BINITT 


GET CHARACTER SIZES. 

CALL CSIZE( HCH, VCH ) 

SET UP VIRTUAL LINDOW. THE SCREEN SIZE IS HSCP.N BY VSCRN FASTER 
UNITS. THE NOMINAL PLOT WINDOW IS HW BY VW RASTFR UNITS. TIC PARKS 
WILL EXTEND OUTSIDE THE WINDOW A DISTANCE VCH. 


vwu= 

VSCRN- 

3*V 

CH 

- 2 * 

HOFF 

VWL = 

VWU-VW* 

1 



- .... 

HWL = 

(HSCRN- 

HW) 

/2 

- 1 * 

HCH 

HWR = 

HUL-*HW- 

1 



— 

CALL 

SLIMX ( 

HWL 

% 

HWR 

) 

CALL 

SL1HY( 

VWL 


vwu 

) - - 


C 

C 

C 


CENTER TITLE BLOCK ACROSS TOP OF VIRTUAL WINDOW. 


IHL= HUL ♦ (HW-LINWDT(8C))/2 
IVL= VSCRN-VCH 

CALL MOVADSC IHL* I VL ) 

CALL AOUTSTC BO, TITLEd.l) ) 

IVL= IVL-VCH-1 

CALL P,OVAES( IHL, IVL ) 

CALL AOUTSK 80, TITLE(1,2) ) 


PUT PLOT LABELS IN LOWER LEFT CORNER. 




IHL= 0 

IVL= VCH-*2 

CALL MOVABS( IHL, IVL ) - - 

CALL AOUTSK NCLABl, LABELl ) 

IHL= HAX0( 0* (NCLAbl>NCLAB2)*HCH/2 ) 
IVL= 0 

CALL MOVADS( IHL, IVL ) - 

CALL AOUTSK NCLAB2, LABEL2 ) 




RETURN 


IgmRiiUtJNi tETPLT ( HOFF. NCLABl. LABCLl. NCLAD2. LABEL2 I 


■ <0592) END ■ 

PROGRAM size: PROCEDURE - 0002G6 LXRKACC > 000076 STACK - 000034 

0000 ERRORS C <SETPLT>FTN-R EV15.3 3 - - 


I 



SUBROUTINE VECPLT ( VSCfLEt 


C0593) 

(0594) 

(0595) 

(0596) 

(0597) 

<0596) 

<0599) 

<0600) 

<0631) 

<0602) 

<0603) 

<0604) 

<0605) 

<0606) 

<0607) 

<0608) 

<0609) 

<0610) 

<0610) 

<0610) 

<0611) 

<0612) 

<0613) 

<0614) 

<0615) 

<0616) 

<0617) 

<0618) 

<0619) 

<0620) 

<0621) 

<0622) 

<0623) 

<0624) 

<0625) 

<0626) 

<0627) 

<0628) 

<0629) 

<0630) 

<0631) 

<0632) 

<0633) 

<0634) 

<0635) 

<0636) 

<0637) 

<0638) 

<0639) 

<0640) 

<0641) 

<0642) 

<0643) 

<0644) 

<0645) 

<0646) 

<0647) 

<0648) 

<0649) 

<0650) 


C 

C 

C 


SUBROUTINE VECPLT < VSCALE* 

• ARRAYt Nit N2t N3t I JE t NCt NANEt NCUt NAMEl 

DOES VECTOR PLOTS OF ARRAY. 


c- 

c 

VSCALE 

<INPUT) 

PLOT SCALE WILL FF 1 CM = VSC 

ALE UNITS. 

c 

ARRAY 

<INPUT) 

ARRAY OF VECTORS TO PLOT. 





DIMENSION ARRAY (N1*N2*N3$ 


c 

Nl*N2*N3 

< INPUT) 

DIMENSIONS OF ARRAY. (M .GE. 

2) 

c 

IJE 

< INPUT) 

EXTENDED MESH INDICATOR. SEE 

FSOLVE. 

c 

NC 

<INPUT) 

NUMBER OF CHARACTERS IN NAME. 


c 

NAME 

<INPUT) 

NAME- OF ARRAY. 

- 




DIMENSION NAMC(N'C) 


c 

NCU 

(INPUT) 

number of CHARACTERS IN UNITS 

LABEL. 

c 

NAMEU 

(INPUT) 

UNITS LABFL. 





DIMENSION NAMEU(NCll) 


c 

COMMON BLOCKS 

(SEE-INIT FOB DOCUMENTATIOI 

c 

LOCAL DECLARATIONS 

. , ... 

' 


INTEGER 

OFFSET* HPB* 

VPB 

• 


INTEGER 

LABEL(l)* LSCALE(3>* BLANK* EOSIGN 



equivalence (SCR2»LAREL) 

DATA blank /4H /t EGSIGN /4H 
DATA SCALE / 48. / 


--=/ 


u 

C initialize plot, draw AXESt 

c 


NCS= iFIX(SCALE)/HCH 
NUS= NCS/NCU 



ENCODE! 

12* 

210* 

LSC 

ALE 

210 

FORMAT! 

IPEl 

0.3* 

2X 

) 


NNW= NCU/NCU 





IF ( NNU 

*NCU 

.LT 

. NC 

L ) 


NCL= 8^ 

NWS* 

NCW* 

4* 

12^ 


ENCODE! 

NCL* 

22C 

* LA 

BEL 

220 

FORMAT! 

8HSC 

ale: 

• 

40! 


C 


AND FUT ON TITLE. 


) VSCALE 


NNW= NNW-»1 
NNWtNCW 

) <BLANK,IWS=1.\US) I EQflGN* 
(NAKEll<INU)tINUsl. KNU) 

‘ 4 J ) 


L'CALEt 


OFFSET: -IFIX<SCALE/2. ) 

CALL SETFLTJ OFFSET* NC, NAME* NCL, LABEL ) 

CALL KOVABSI LINUDT<7). <VCH+2)/3 ) 

CALL DRUABS< L I NWDT ( 7 ) ■* I F I X ( £C ALE ) » (VCH^2)/3 ) 

C 

CALL AXES< O.t 1.* OFFSET* 5* 2* 16* 16H < X- XE ) / « XL- XE ) • 

* 0.« 1.* OFFSET* 5* 2v 8* 8H Y /L * 

• 0* NULL* 0* NULL ) . . 

C 

C PUT PARAMETER BLOCK ON PLOT. _ _ 

C 

VPB= VUL^ OFFSET- 3»VCH-3- 2*VCH 
NPB= NPDL/ {VPB/(VCH-*2)> 

IF < <VP0/CVCH^2) .LT. NPBL ) NPB= NPB^l 

HPB= LINWCTI MAXO(NC*NCL) ♦ 5 ) 

HPB= MAX0< HPB* HSCRN- NPB*L INWDT t NP ECH )- (NPB-1 ) *L INWDT (5 ) ) 
CALL 6PbLK< HPP* VPB ) 

C 


. .SUBROUTINE VCCPLT ( VSCALCt 


(0651) 

(0652) 

(0653) 

(0654) 

(0655) 

(0656) 

(0657) 

(0658) 

(0659) 

(0660) 

(0661) 

(0662) 

(0663) 

(0664) 

(0665) 

(0666) 

(0667) 

(0668) 

(0669) 

(0670) 

(0671) 

(0672) 

(9673) 

(0674) 

(0675) 

(0676) 

(0677) 

(0678) 

(0679) 

(0680) 

(0681) 

(0682) 

(0683) 

(0684) 

(06f«S) 


C 

c 


c 


c 

c 

c 


c 

c 

c 

c 

c 


c 


INITIALIZE ARROUHEAU CALCULATION AND BEGIN LOOPS THROUGH MESH. . 


HANGS 30.* ATAN2(1..0.)/ 90. — ■ 

HRs l./COS(HANG) 

HBASEs 2.* HR* SIN(HANG) . ... 

DO 500 Jsl.NJ 

DO 500 I=ltM 

DRAW VECTOR ROOY. 

XVEC= XX( I)*FLOAT(HW) 

YVECs YY<J)*FLOAT(VW) 

call' M0VABS( HWL*IFIX(XVEC)» VWL* IFI X« Y VEC) ) 
XVECs SCALE* ARRAY(1.I*IJL*J*IJE)/VSCALE ♦ XVEC 
YVECs SCALE* ARR A Y ( £ » I *I JE tO* I JE ) /VSCAL E ♦ YVEC 
CALL CRUADS( HWL* I FI X ( X VEC) ♦ VUL* IFI X ( V VE C ) ) 

. DRAU VECTOR HEAD. .. 

NOMINAL HEAD LENGTH IS .15* VECTOF LENGTH. 
MINIMUM HEAD LENGTH IS .1* VSCALE. 


* 



VLNTHs SORT! ARR A V ( 1 . 1 ♦IJE t J* I JE ) * *2 ♦ 

ARR AY(2*I*IJEf J*IUE > **2 ) / VSC 
IF ( VLNTH .LT. PRCSN ) GO TO 500 
VANGs ATAN2( ARR A Y ( 2 » 1* I JE« J* I JE) i AFRAYd.l 
HL= AMAXK .15* VLNTH« .1 ) 

XVECHs SCALE* HL*HR* COS( VANG+HANG) 

YVECHs SCALE* HL*HR* SIN( VANC+HANC) 

CALL DRWABS( HUL + IFIX (XVEC-XVECH) « V'.L*1FIX< 
XVECHS SCALE* HL*H«ASE* SINIVANG) * XVCCH 
YVECHs -SCALF* HL*HbASE* COS(VA.\G) ♦ YVECH 
CALL MOVAOS( HWL*IFIX(XVEC) » VWL* IFI X ( Y VEC ) 
CALL DRWABSC HWL* 1 F 1 X ( X VEC-X V ECU) « VVL*IF1X< 


ALE 

-»IJr.J*IJE5 


YVEC-YVECH) 


) 

YVEC-YVECH) 


) 


) 


) 


(0686) SCO CONTINUE 

(0687) C 

(0688) C FLUSH PLOT DUFFER* RETURN TO ALPHANUMERIC MCDE. AND UAIT FCR OPEPATl 

(0689) C RESPONSE. . .. 

(0690) C 

(0691) 600 CALL MOVADS( 0. VSCRN-). . - 

(0692) CALL ANMCDE 

(0695)- CALL WAIT -- - - 

(0694) RETURN 

(0695) C . - -- 

(0696) END 

PROGRAM size: PPCCECURE - 001403 LINKAGE - 000223 . STACK - 000066 

0000 ERRORS C < VECPLT>F TN-R EVl 5.3 3 


ORIGINAL PAGE IB 
„ . OP POOR QUALIT'^ 


SUOROUTINC VPROFS ( NPRF. FRFt APIKt APAX» NATCSt ARCALl ♦ 


(0697) 

(0698) 

(0699) 

(0700) 

(0701) 

(0702) 

(0703) 

(070A) 

(0705) 

(0706) 

(0707) 

(070B) 

(0709) 

(0710) 

(0711) 

(0712) 

(0713) 

(0714) 

(0715) 

(0716) 

(0717) 

(0718) 

(0719) 

(0720) 

(0721) 

(0722) 

(0723) 

(0724) 

(0725) 

(0726) 

(0727) 

(0727) 

(0727) 

(0728) 

(0729) 

(0730) 

(0731) 

(0732) 

(0733) 

(0734) 

(0735) 

(0736) 

(0737) 

(0738) 

(0739) 

(0740) 

(0741) 

(0742) 

(0743) 

( 0744 ) 

(0745) 

(0746) 

(0747) 

(0748) 

(0749) 

(0750) 

(0751) 

(0752) 

(0753 ) 

(II ?*34S 


SUOROUTINC VPROFS ( NPRF* PRF* AMIN* AMAX* NATOS* ASCALC* 

• ARRAY* M* N2* NS* IJC * NO* NAME* 

* NCU* NAMCU ) 

C 

C PLOTS SELECTED VERTICAL PROFILES OF ARRAY. - • - 

C 
C 
C 
C 

c 
c 

c 
c 
c 
c 
c 
c 
c 


NPRF 

(INPUT) 

NUMBER OF FROFILES TO PLOT. 

PRF 

(INPUT) 

XX VALUES OF PROFILES TO PLOT. 

UILL INTERPOLATE LINEARLY TO VALUES BETWFET 
TABULATED VALUES OF XX. 

DIMENSION PRF(NPRF) 

AMIN 

(INPUT) 

MINIMUM VALUF ON VERTICAL AXIS (SCALED 

V 


BY 10**ASCALE). 

AMAX 

(INPUT) 

MAXIMUM VALUE ON VERTICAL AXIS (SCALED 
BY 10**ASCALE). 

NATOS 

(INPUT) 

NUMBER OF TIC SPACES ON VERTICAL AXIS. 

ASCALE 

(INPUT) 

SCALE FACTOR FOR PLOTTING WILL BE 


. » 

10«*ASCALE. .... 

INTEGER ASCALE 

ARRAY 

( INPUT) 

ARRAY TO PLOT. 

DIMENSION ARRAY (N1 ,N2 .N3) 

N1 fN2 ,N3 

(INPUT) 

DIMENSIONS OF ARRAY. 

IJE 

(INPUT) 

EXPANDED MESH INDICATOR. .REE fSOLVE. 

NC 

(INPUT) 

NUMBER OF CHARACTERS IN NAME CF ARRAY. 

NAME 

(INPUT) 

NAME OF ARRAY -USED TO LABEL HCRIZONTAL AX] 
DIMENSION NAME(NC) 

NCU 

(INPUT) 

NUMBER OF CHARACTERS IN ARRAY UNITS. 

NAMED 

(INPUT) 

ARRAY UNITS - USED TO LABEL HORIZONTAL AXI5 
DIMENSION NAMEU(NCU) 

COMMON BLOCKS 


(SEE INIT FCR COCUMrNTATK 


LOCAL DECLARATIONS 

DIMENSION APPFn ) - - 

EQUIVALENCE <SCR2*APRF) 

DIMENSION LADEL«l) 

EQUIVALENCE (SCROaABEL) 

DIMENSION LAPSCLO) ~ * 

INTEGER HK, VK , HPP. VPB 

INTEGER PAT i 6) _ 

data pat / 11. 56 * 34* 12* 3212. 321212 i 

C 

c 

C initialize PLOT. PUT ON LAGELS AND TITLES. AND DRA.! AXES. 

C LAKEL WILL CONTAIN THE NOME OF ARRAY. THE SCALE FACTOR. IF 
C ANY. AND THE UNITS OF ARRAY, 

C GPDLK PUTS ON THE PARAMETER BLOCK. ' 

C , 

CALL SETPLTI 0. 20* 20HVERTICAL PROFILES OF, NC , NAME ) 
C . „ 

HPB= HU'R*VCH*HCH 

VPD= VUU- (VU-NPP.L* ( VCH*2) )/2 , . 

CALL GPOLK5 HPB, VPB ) 


210 


NNW= NC/NCW 

IF ( NCU*NNW .LT. NC ) NNU=NNU*1 
ENCODE < 12, 210, LADSCL ) ASCALE 
FORMAT < 7H X 10**. 13. 2X ) 

DO 215 INU=1,3 


SUBROUTINE VPROFS ( NPRFt PRF* ANlNt AHAXt NATCSt ASCALE« 


1 


1 . (0755) 

215 

LADEL( INU«NNU)= LABSCL 

* (0756) 


00 230 INW=ltNNU 

(0757) 

230 

LABEL(INk)=rvAKE( INU) 

] (0758) 


NNL= NNU«3 

i (0759) 


IF (ASCALE.EG.O) NNL= 1 

^ (0760) 


NNWs NCU/NCW 

(0761) 


IF ( NCU*NNU .LT. NCU 

(0762) 


DC 240 INW=l«NNk 

i (0763) 

240 

LAbEL( IM.>NNL) = NAHEU( 

(0764) 


NCL= (NNL<»NNW)*NCU 

(0765) 

C 


i{ (0766) 


CALL AXES! AHINf ANAXt 

i; (0767) 


* 0 . f 1 . « 

(0768) 


* Ot NULL* 0* 




2f R« 8H Y/L 


(0769) 

(0770) 

(0771) 

(0772) 

(0773) 

(077A) 

(0775) 

(0776) 

(0777) 

(077P) 

(0779) 

(0780) 

(0781) 

(0782) 

(0783) 


C SET PLOT VARIABLES FOR CURVES. 

CALL NPTS( NO ) 

CALL DUINDO( AR I N/ ( 1 0. * • ASC A LE) « AKAX/( 10. *• ASCALE) « 0. 
C 

IF (N2.E0.1) liO TO 500 . 


C INITIALIZE OF LINE PATTERN KEY BLOCK.— 
C 

LKL= 5 0 

LKT= LKL-»LINV/0T(2A) 

VK= VWL-3*VCH-3-2*VCH . — . 

NKR= NPRF/ (VK/CVCH*?)) 


1 . ) 



(0784) 



HK= LINLDT( MAXC(20 


(0785) 



HK= FAX0( HK« HSCRN 

5 : 

(0786) 



IHK= HK 

{ 

. (0787) 



IVK= VK*VCH-*2 

1 

1 

(0788) 

C 



, i 

(0789) 

c 

LOOP 

THROUGH PROFILES.. 

ij 

(0790) 

c 




(0791) 



DO 480 IPRF=1.NPRF - 


(0792) 

c 




(0793) 

c 


LOCATE EACH PRF 


(0794) 

c 



■; 

(0795) 



DO 320 I=2«NI 


(0796) 


320 

IF ( PRF(IPRF) .1 

^ ■ 

(0797) 



I =N I 

(j 

(0798) 

c 




(0799) 


340 

FACT= (PRF(IPP.F) 


(0800) 



DO 360 J=1«NJ 


(0801) 



APRF(J)= ARRAYd 

1 

(0802) 



FACT*( 


IF ( (VK/(VCH^2))*NKB .LT. NPRF ) NKB= NKB+1 

) •» 5 ) 

KB«LKT- (NKB-1)*LINWDT(5) ) 


CURVE. 


>1.J-»IJE) ) 


(0803) 
(0804) 
(0805) 
(0806) 
(0807) 
(0808) 
(0809) 
(0810) 
(0811 ) 
(0812) 
(0813) 
(0814) 


360 


CONTINUE 


C 

C 

C 


IPAT= PAT( MCD(1FPF«5»6)*1 ) 
CALL LINE( ITAT ) 

CALL CPL0T( APRFt YY ) . 

LABEL LINE PATTERN 


IVK= IVK-VCH-2 - — _ 
IF (IVK.GE.O) GO TO 420 
IVK= VK 

IHK= IHK-*LKT*LINWDT(5) 


I ^ 


0^ pooe-quIut? 





SUBROUTINE VPROFS ( NPRFt PRFt AMIN* AMAR* NATOS* ASCALC* 


C0815) 
(081&I 
(0817) 
(0818) 
(0619) 
(0820) 
(0821) 
(0822) 
(0823) 
(0624) 
(0825) 
(0626) 
(0827) 
(0828) 
(0829) 
(0830) 
(0831) 
(0832) 
(0833) 
(0834) 
(0835) 
(0836) 
(0837) 
(0838) 
(0839) 
(0840) 
(0841) 
PROGRAM 
0000 ERR 


420 


430 

440 


C 

480 

C 

C 


IF ( IHK^LKT ,CT. HSCRN ) GO TO 480 - 

CALL MCV4BS ( IHK* I VK^ ( V CF + 2 )/3 ) 

CALL OSHABSI IHK*LKL« I VK^ < VCH^2 ) /3 * IPAT ) 

CALL MOVABSC IHK^LKL* i VK ) 

IF (IVK.EO.VK) ENCODE! 24 * 430* LABEL ) PRFdPRF) 
IF (IVK.LT.VK) ENCODE! 24 * 440* LABEL ) PRFdPRF) 
FORMAT! 18H < X-XE)/( XL-XE) =* F6.3 ) ~ 

FORMAT! IHX* F6.3 ) 

CALL AOUTSTi 24* LABEL ) - - - - — - - - • 

CONTINUE • - 

GO TO 6P0 — 


C PLOT SINGLY DIMENSIONED ARRAY. 

C 

500 CALL CPLCT( ARRAY* YV ) — 

C 

C FLUSH PLOT BUFFER* RETURN TO- ALPFANUMfER I C MODE* AND WAIT FOR OPERAT 
C RESPONSE. 

6C0 CALL MCVABS( 0* VSCRN ) 

CALL ANMODE - 

CALL WAIT 

RETURN . 

C 

END - ... . _ 

size: PROCEDURE - 001466 LINKAGE - 000227 STACK - 000102 

ORS C<VPR0FS>FTN-REVIE,33 - . - . . 



c* 


fooon 
( 0002 > 
(0003) 
(0004) 
(0005) 
(0006) 
(0007) 
(OOOt*) 
(0009) 
( 0010 ) 
( 0011 ) 
( 0012 ) 
(0013) 
(0014) 
(0015) 
(0016) 
(0017) 
(OOIB) 
(0019) 
(0020 
( 0021 ) 
( 0022 ) 
(0023) 
(0024) 
(0025) 
(0026) 
(0027) 
(0028) 
(0029) 
(0030) 
(0031) 
(0032) 
(0033) 
(0034) 
(0035) 
(0036) 
(0037) 
(0038) 
(0039) 
(0040) 
(0041) 
(0042) 
(0043) 
(0044 ) 
(0045) 
(0046) 
(0047) 
(0048) 
(0049) 
(0050) 
(0051 ) 
(0052) 
(0053) 
(0054) 
(0055) 
(0056) 
(0057) 
(0058 ) 
(0059 ) 
( 0060 ) 


APPENDIX B . .. . . . 

DATA BASE MANAGER LISTING 

c . " 

C 

C ■ 

C CONTROLLER FOR ALLOY DATA BASE MANAGER. _ _ _ 

C . . - . - — 

C KOOFL 1 (12/79) 

c ■ ■ 

C • SETS UP CARO IMAGE DATA BASE FOR INPUT TO „ _ 

C THF MRS SOLIDIFICATION MODEL. 

C 

C 

C COMMON BLOCKS _ _ 

COMMON CRT. OLDDB. NEWDEt ” 

• NAH(13il5)» NN» VLlJ(3tl5)t NVt _ 

• ' ^ ■ SOIVNT. SOLUTE. ALREF<20»5). 

• FERROR(7). FBOUNDIl*). FA4(1). Fe0CH(2)« 

• FMTK5). FMT2(2), GUinE(20) 

INTEGER CRT. OLDCE. NEWDB. _ 

• SOLVNT. SOLUTE.' ALBEF. 

• FERROR. FBOUND. FA4. F80CH* 

• * ■■ FMTl. FMT2. GUIDE - - 

C 

C LOCAL DECLARATIONS 

LOGICAL NOOLD. SAVOLO 
INTEGER ADeREF(20) 

INTEGER CODE 

INTEGER CBNAMECP). RENAME'(2) 

DIMENSION IPSP(l) 

c — — - — : 

c 

C SET UP HOLLERITH ARRAYS AND CONSTANTS. 

C 

RINF= 1.E37 

CRT= 1 _ 

OLDDBs 5 ■ ■ 

NEUDB= 6 

NN= 13 ' ' ■ 

NV= 11 

CALL SETHOLI NAMd. 1). 52. 52H‘ ENTER MINIMUM CL <LT FCT) .... 

• ) 

VLU(2. 1>= 0. - - 

VLU(3. 1>: 100. 

CALL SEThOLI NAMd. 2). 52. E2H ENTER MAXIMUM CL «WT PCT) .... 

• ) 

VLU(2. 2)= 0. " ■ 

VLU(3. 2)= ICO. 

CALL SETHOL< NAMd. 3). 52.'52H "ENTER ' TEH PE RA TURE- C OMP OS I T ION 
*PE (DEG C/‘’CT) .. ) 

VLU(2. 3)= -RINF " 

VLU(3. 3)= 0. 

CALL SFThOLC NAMd. 4 > .' 52i" 52H "ENTER EQUILIBRIUM PARTITION RA 

. ) 

VLUI2. 4)= n. • ■ ■ • 

VLU(3. 4)= 1. 

CALL SETHOLI NAMd. 5). 52. 52H~" ENTER EUTECTIC COMPCSITION (WT 

• T) ) 

VLU(2. 5)= 0. ■ ■ 

VLt(3. 5)= 100. 

CALL SETHOL( NAMd. 6). 52. 52H ENT ER ' EUT ECt 1C TEMPERATURE (OE 

•) ) 



c 


I ’ 

i 

I 



(0061) 

(0062) 

(0063) 

(0064) 

(0065) 

(0066) 

(0067) 

(0066) 

(0069) 

(0070) 

(0071) 

(0072) 

(0073) 

(0074) 

(0075) 

(0076) 

(0077) 

(0078) 

(0079) 

(0080) 

(0081) 

(0082) 

(0083) 

(0084) 

(0085) 

(0086) 

(0087) 

(0088) 

(0089) 

(0090) 

(0091) 

(0092) 

(0093) 

(0094) 

(0095) 

(0096) 

(0097) 

(0098) 

(0099) 

( 0100 ) 

( 0101 ) 

( 0102 ) 

(0103) 

(0104) 

(0105) 

(0106) 

(0107) 

(0108) 

(0109) 

(0110) 

( 0111 ) 

( 0112 ) 

(0113) 

(0114) 

(0115) 

(0116) 

(0117) 

(0118) 

(0119) 

( 0120 ) 


VLU(2f 6)s -PINF 
VLU(3« 6)= RINF 
CALL SCThOL( NAMdt 7)t 
•CH/CP*»3)/PCT ... ) 
VLU(2t 7)= -RINF 
VLU(3t 7)= RINF 
CALL SFTHOLC NAMdt 8)t 

• (GM/CK**3) ) 

VLU(2t R)= 0. ' 

VLU(3t b)= PINF 
CALL SETHOLC NAMdt 9)t 
*/CM**3) ......... ) 

VLU(2t “)= 0. 

VLU(St 9)= RINF 

CALL SETHOL( NAMd.tlOt 


‘5l t* '52 M ENT ER"cb m'P OS if ION - DENSITY SLOPE 
52 1 62H‘ ENTER PRIMARY PHASE SOLID DENS I 
52t 52P ENT'ER EUTECTIC LICUlD DENSITY ( 
52 V 5^H ENTER'EUfECf IC SCLIC DENSITY (C 


*CM**3) ) 

VLU(2fl0)= 0. 

VLU(3fl0)= RINF 

CALL SETHOLf NAMd tl 1 ) t"52 t 52K " ENTER VIS COSITY ( C-M / ( CM tSEC ) ) .. 

* ) 

VLU(2td ) = 0. 

VLU(3tll)T«?lNF 

CALL SETHOU DDNAME i 8 1 ' 8 HM I'iO iB" ) 

CALL SETHOLI RENAME. 8. 8HM1.TDB ) 

CALL SETHOL( FERBCR.‘28» 28H ( 2?H *****' INVA LID RESPONSE ) ) 

CALL SFTPOU FBOUND. 56* 56H(2PH***** VALUE MUST BE IN RANGE .ir’E 
*.3*3H TC.1PE10.3) ) 

CALL SETHOLC FA4. 4, 4HCA4) ) 

CALL SETHOLC FbOCHt 8. 8HC20A4) ) 

CALL SETHOLC FMTI. 2C. 2 OH C A 4 «6X « A4 « 6X « 2E1 0 . 3 ) > 

CALL SETHOLC FMT2. 8. EHC8E10.Z) ) 

CALL SETHOLC CUlDEt 80« 80H 0 0 0 

*0 0 0 C ...0 ) 


c 

c 

c 


c 

c 

c 


r. 

c 

c 

c 

c 

c 


INITALIZr TEKTRONIX TERMINAL CONTROL SYSTEM. 


CUSED ONLY 

FOR N 

EUP 

AG.) 

CALL 

INITTC 

120 

0) 

CALL 

TERMC3 

,10 

24) 

CALL 

CHRSI2 

C4) 

. . . 

CHECK FOR 

EXISTA 

NCE 

OF 0 

CALL F 

ILES C 

1. 

DBNAM 


NOOLD= (CODE .NE.O) 

IF CNOOLO) CALL MSG C 48. 48HNC OLD DATA BASE. BEGIN BUILDING NEl 
* ATA BASE. ) 

IF C NOOLC ) GO TO 310 


CHANGE NAME OF OLD DATABASE. _ • _ 

IF USER WANTS TO SAVE OLD. ASK FCR NAME. ' “ ' 

OTHERUISF USE TEMPORARY NAME RENAME FOP OLD DATA BASE. AND DELETE I'. 
AFTER NEW IS WRITTEN, 


200 CALL MSGC 60. 60HDO YOU WANT' TO SAVE A COPY OF THE OLD DATA BA5C 
* CY CR N) ) 

SAVOLD- .FALSE. 

IRSPC1)= 4H 

READ CCRT,FA4,ERR=230) IRSP” 

IF C CIRSPCl ).E0.4HN ) .OR . C I RSP C 1 ) .EO.4HN0 ) ) GC TC 260 



ORIGINAL PAGE Sc 
OF POOR QUALITY 


( 0121 > 

( 0122 ) 

(0123) 

(0124) 

(0125) 

(0126) 

(0127) 

(0126) 

(0129) 

(0130) 

(0131) 

(0132) 

(0133) 

(0134) 

(0135) 

(0136) 

(0137) 

(0136) 

(0139) 

(0140) 

(0141) 

(0142) 

(0143) 

(0144) 

(0145) 

(0146) 

(0147) 

( 0148 ) 

(0149) 

(0150) 

(0151) 

(0152) 

( 0153 ) 

(0154) 

(0155) 

(0156) 

(0157) 

(0158) 

(0159) 

(0160) 

(0161) 

(0162) 

(0163) 

(0164) 

(0165) 

(0166) 

(0167) 

(0168) 

(0169) 

(0170) 

(0171) 

C0172) 

(0173) 

(0174) 

(0175) 

(0176) 

(0177) 

(0178) 

(0179) 

(0180) 


IF ( ( IRSFd ).EC.4HY ) .OR • ( IRSP ( 1 ) .EQ .4H YE ) .OR . 

* (IRSPd ).EC.4HYES ) ) 6C TO 250 

230 WRITE (CRTtFERROR) 

GO TO 200 _ ^ 

C - - -• 

250 SAVCLD= .TRUE. 

CALL M.‘=G( 44* 44HENTER COPY FILE NAME (UP TO 6 CHARACTERS) ) 

READ <CRT,FR0CH) RENAME 

CALL FILEEI 1« PENAMEt OUMt CUM» CODE ) 

IF (CODC.NE.O) OC TO 270 

CALL MSG( 24* 24HNAHE ILLEGAL CR IN USE ) 

GO TO 250 _ 

C 

260 CALL FILES( 5* RENAME* DUM* DUM * CODE ) 

270 CALL F,ILES( 6* DBNAME*’ DUM* RENAME* CODE ) ' " 

IF (CODE.NE.O) GO TO 3000 _ _ _ 

C . 

C OPEN OLD AND NEW DATA BASES AND GET IDENTIFIER FOR NEW. 

C 

CALL F1LES( 2* RENAME* OLODB* DUMjr CODE ) _ 

IF ( CODE.NE.O > GO TO" 3000 

READ (OLCCP* F80CH*END=480»ERR=4S0) ADBREF. 

CALL MSG( 28* 28H0LD DAT A’ EASE IDENTIFIER IS) ) 

CALL MSG{ eO* ADBREF ) _ _ „ 

CALL MSC( 4* 4H ) 

310 CALL FILES( 3* OBNAME* NEWDB* DUM* CODE ) 

IF ( CODE.NE.O > GO TO 3000 

CALL MS.GT 52i» 52HENTER NEW DATA BASE IDENTIFIER (UF TO 80 CHARA 

* RS) ) 

CALL MSC( 80* GUIDE ) _ 

READ (CRT*FaOCH) ADFREF 
WRITE (NEWDP.F80CH) ADBREF 
IF (NOOl.D) GO TO 500 
C 

C READ EACH DATA SET FROM OLD DATA BASE* MODIFY IT* AND WRITE IT 
C OUT TO NEW DATA BASE. 

C 

400 READ (OLCCB* FMT1*END=500*ERR=4‘=C) SOLVNT* SOLUTE* VLUd*D* 

* VLU( 1,2) 

READ <OLDDB»F80CH*ENC=4E0f EPR=4°n> ALRCF • 

READ <OLDDP»FMT2.END = 480*ERF.=490 ) ( VLU d * I V ) * I V = 3 * 6 ) 

READ <CLDDb*FMT2*END = 4RC*ERR=490) { VLU <1 » I V ) 1 1 V = 7 . 1 0 ) 

READ (OLODB. FMTr*END = 4e0*ERP=4°0) VLLd*ll) 

C 

CALL HOPWRI 
GO TO 400 

C * 

480 CALL MSG( 44 * 4 4 H* * * • * UNEX FE CT ED END-CF-FILE ON OLE DATA BASE ) 
CALL MSG( 32* 32H** * * * SK IPP 1 NC TO DATA SET INPUT ) 

GO TO 500 _ 

490 CALL MSC( 36* 36H*«*»*F0RMAT ERROR IN OLD DATABASE ) 

CALL HSG( 32* 32H* *• * *SK IPP I NG TO DATA SET INPUT > 

c ■ - - - 

C INPUT NEW DATA SET. MODIFY IT If_NFCESS ARY . ANDJIRITE IT 
C OUT TO NEW DATA BASF. ‘ . '■ 

C 

500 CALL NEWPAG 

CALL MSG(48* 48HENTER NAME OF SOLVENT (UP TO_4 CHARACTERS)* OR 
' CALL MSG(4P., 48H 0 'TO TERMINATE DATA SE T "SF EC I F 1 C AT 1 ON 

READ (CRT.FA4) SOLVNT 



IF <S0LVNT.C0.4H0 > GO TO 600 


(0181) 

(0162) C _ 

(0183) CALL MS6( A^HENTER NAHE~OF SOLUTE (UP TO 4* C HA P A C f E R s")~ ) 

(0184) RFAO (CRT|FA4) SOLUTE • 

(0185) C ‘ 

(0186) CALL MSG( f6« S6HENTER ALLOY REFERENCE (5_ LINES OF UP TO 80 CHA 

(0187) *TESS) ) 

(0188) CALL HSG( BOf GUIDE ), 

(0189) READ (CRT.F80CH) ALREF 

(0190) C 

<0191) DO 560 IVslfNV 

(0193) 520 CALL HSG( 4«NN» NAH(1*IV) ) _ _ _ „ 

(0193) HEAD (CRT,*»ERP=E60) VLU(1»IV) 

(0194) IF ( (VLU(ltIV).Gr,VLU<2»IV)) .AND. __ 

(0195) • (VLU(1« IV).LE.VLU(3«IVM > GO TO 5F0 

(0196) WRITE ^(CRT.FBOUNO) VLU(2»IV)t VLU(3tIV) 

(0197) GO TO 520 

(0198) 560 WRITE (CRT.FERPOR) 

(0199) GO TO 520 " 

(0200) 580 CONTINUE 

(0201) C ■ *■ " ■ 

(0202) CALL HODWRI 

(0203) GO TO 500 

(0204) C 

(0205) C CLOSE NEW DATA EASE* DELETE 'OLO' IF iT WAS NOf'TC BE SAVEC. 

(0206) C 

(0207) 6C0 CALL FILES( 4t DBNAPE*' NEWOB'V DUH* CODE )’ 

(0208) IF (KOOLC) CALL EXIT 

(0209) CALL FILES! 4» RENAHE* DLDCE* CUHt CODE ) 

(0210) IF ( .NOT.SAVCLO) CALL FILES! 5» RENAMEt DUH» DUK, CODE ) 

(0211) CALL EXIT 

(0212) C 

(0213) 3000 CALL H'G( 20t 20M****FILE USAGE ERROR ) 

(0214) CALL EXIT _ 

(0215) C • ■ “ " . . 

(0216) END 

PROGRAM size: FRCCFDURE - 003432 LINKAGE - 000341 STACK - 000022 

0000 ERRORS C<.MAIN.>FTN-REV15.33 


SUOROUTINi: POOURl 


(0217) 
(021B) 
(0219) 
(0220) 
(0221) 
(0222) 
(0223) 
(0224) 
(0225) 
(0226) 
(0227) 
(022R) 
(0229) 
(0230) 
(0231) 
(0232) 
(0233) 
(0234) 
(0235) 
(0236) 
(0237) 
(0230) 
(0239) 
(0240) 
(0241) 
(0242) 
(0243) 
(0244) 
(0245) 
(0246) 
(0247) 
(0248) 
(0249) 
(0250) 
(0251) 
(0252) 
(0253) 
(0254) 
(0255) 
(0256) 
(0257) 
(0258) 
(0259) 
( 0260) 
(0261) 
(0262) 
(0263) 
(0264) 
(0265) 
(0266) 
(0267) 
(0268) 
(0269) 
(0270) 
(0271) 
(0272) 
(0273) 
(0274) 
(0275) 
(0276) 


SU8RCUTIKC RODURl 
C 

C MODIFY INDIVIDU4L ELEMENTS OF DATA SET* AND 
C WRITE DATA SET OWT TO NEW DATA BASE. 

C 

C 

C COMMON BLOCKS 
COMMON 

« 

* 

INTEGER 

* V ~ 

* 

C 

C LOCAL DECLARATIONS 

DIMENSION IRSP(l) 


CRT. OLDDB* NEWOB* 

NAH(13*15)« NN« VLU(3*15)« NV* 

SOLVNT* SOLUTE* ALi! EF ( 20 * 5 ) * 

FERR0R(7)* FECL'NC(14)« FA4(D* F60CH(2)* 
FMTK5)* FMT2(2)* CUIDE(20) 

CRT* OLDDP. NEV'DD* 

SOLVNT* SOLUTE* ALREF* 

FERROR* FBOUND* FA4* FfiOCH* 

FMTl* FMT2* GUIDE 


C -j: 

C 

C CLEAR SCREEN AND WRITE CURRENT VALUES^ _ 

C 

200 CALL NEWPAG . .. 

C 

WRITE (CRT.220) SOLVNT, SOLUTE _ 

220 FORMAT! 15H 1 SOLVENTS* 5X, A4* 

* /15H 2 solute: * 5X, A4 ) 

C 

WRITE (CRT, 230) ALREF 

230 FORMAT! 24H 3 ALLOY REFERENCE: , 20A4* 

* / (24X* 20A4) ) 

c 

,NV3= NV^3 

WRITE (CRT, 240) ( IV* (NAM( IN* IV-3) , IN=3,NN) * VLU(l,IV-3>* 

* 1V=4,NV3 ) 

240 FORMAT! 14* 3X* 11A4* * 1PE12.5 ) 


C 

c 

c 


c 


ALLOW USER TO 

MA 

KE CHANG 

ES. 





300 

CALL 

MSG( 

4, 

4H 

) 



• - - 




CALL 

MSG( 

4, 

4H 

) 






CALL 

MSG ( 

4, 

4H 

) 






CALL 

MSG ( 

6P 

,68HENTE 

R C 

TO 

CCP 

V 

THIS 


*E NEW 

DATA 

D 

ASE, ) 







CALL 

MSG! 

5 6 

,56H 

0 

TO 

OKI 

T 

THIS 


•SE* OR ) 









CALL 

MSG! 

28 

,28H 

I 

TEM 

MUM 

H 

ER TO 


IRSP( 

1)= 4H 








READ 

(CRT, 

FA 

4,ERR=34 

0) 

IRSF 




IF (I 

Rsrd 

) . 

EC.^HC 

) 

GO 

TO 5 

rt 

0" 


IF (I 

RSPd 

} . 

E0.4H0 

) 

RETURN 




IF (IRSPd 

) . 

E0.4H 

) 

CO 

TO 34 

0 ■■ ‘ 


DECODE! 4* 

* 

, IRSP, 

ERR 

= 34 

C ) 

I 

TEM 


IF ( 

(ITEM 

• L 

T.NV*4) 

.AN 

0. 

(ITE 

M 

.GT.O) 

340 

WRITE 

(CPT 

,F 

ERROR) 







GO TO 

3C0 








350 

IF ( 

ITEM. 

CT 

.3 ' y GO" 

TO 

410 

— 

— 



GO TO 

(360 

,3 

70,380) , 

ITEM 





DATASET AS IT STANDS INTO 
DATA SET FROM THE NEW DATA 
CHANGE. ) 


) GO TO 350 


'ORIGINAL PAGE Xa 
ol' POOR QUALITY 


SUOROUIINC MODUR 1 ' 


(0277) 

(0276) 

(0279) 

(0280) 

(0281) 

(0282) 

(0283) 

(0289) 

(028&) 

(0286) 

(0287) 

(0286) 

(0289) 

(0290) 

(0291) 

(0292) 

(0293) 

(0299) 

(0295) 

(0296) 

(0297) 

(0298) 

(0299) 

(0300) 

(0301) 

(0302) 

(0303) 

(0309) 

(0305) 

(0306) 

PROGRAM 


(UP TO 9 CHARACTERS) 


(UP TO 9 CHARACTERS) 


360 CALL MSG( 36t 36HENTER SOLVENT 

READ (CRTtFA9) SOLVNT 

GO TO 200 

370 CALL MSC( 36 « 36HENTER SOLUTE 
READ (CRT.FA9) SOLUTE 
GO TO 2C0 

380 CALL MSC( 66t 56HENTER ALLOY REFERENCE <5 LINES OF UP TO 80 CHAt 
*TERS) ) 

CALL MSG( aOt GUIDE ) 

READ (CRTtFSOCM) ALREF 
GO TO 200 

910 IV=ITEP-3 

CALL HSG( 9*NN« NAH(1*IV) , - ■ 

READ (CRT»** ERRS930) VLUd.IV) 

IF ( (VLUd* IV).GE.VLU(?«IV)) .AND.' 

• (VLU(1«IV).LE.VLU(3«IV)) ) GO TO 2C0 

WRITE (CRT.FBOUNO) VLU(2«IV)t VLU(3«IV) 

GO TO 91C _ 

930 WRITE ICRT.FERROR) 

GO TO 910 


C WRITE CURRENT VALUES OUT TO NEW DATA BASE. 

c ' 

500 WRITE (NEkOB.FHTl) 

(NEVDD.F80CH) 

(\EW0PmiFMT2) 

(NEWDn.FHT2) 

(NEWDB.FKT2) 


size: 


WRITE 
WRITE 
WRITE 
WRITE 
WRITE 
RETURN 
END 

PROCEDURE - 001960 


SOLUTE* VLU(l.l). VLU(1*2) 


SOLVNT. 

ALREF 

(VLlKltl V).IV=3«6) 
(VLua.I V) f IV=7.10) 
VLUdtll) 


LINKAGE - 000139 


STACK 


000020 


0000 ERRORS C <MOD UR 1>F TN-RE VI 5.3 3 


SUbROUTINC FILES! NTRYt FNAHC* 


rUNlT* CNAHC* CODE 


(0307) 

(0306) 

(0309) 

(0310) 

(0311) 

(0312) 

(0313) 

(0314) 

(0315) 

(0316) 

(0317) 

(031fi) 

(0319) 

(0320) 

(0321) 

(0322) 

(0323) 

(0324) 

(0325) 

(0326) 

(0327) 

(0328) 

(0329) 

(0330) 

(0331) 

(0332) 

(0333) 

(0334) 

(0334) 

(0335) 

(0336) 

(0337) 

(0338) 

(0339) 

(0340) 

( 0341 ) 

(0342) 

(0343) 

(0344) 

(0345) 

(0346) 

(0347) 

(0348) 

(0349) 

(0350) 

(0351 ) 

(0352) 

(0353) 

(0354) 

(0355) 

(0356) 

(0357) 

(0358) 

(0359) 

(0360) 

(0361 ) 

(0362) 

(0363) 

(0364) 

(0365) 


C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

C' 

c 


c 

c 


c 


c 

c 


c 


SUDROUTINC FILES! NTRYt FNAHE* FUNlTt CNAME* CODE ) 
PERFORMS FILE OPERATIONS USING PRIME SYSTEM ROUTINES. 


NTRY 


FNAME 
FUN IT 
CNAME 
CODE 


(INPUT) 


(INPUT) 

(INPUT) 

(INPUT) 

(OUTPUT) 


1 CHECK EXISTANCE OF FILE FNAMF IN CURRENT LJ 
RETURNS COOES C IF IT EXISTS. 

NONZERO OTHERWISE. 

"2~" OPEN FILE FNAME ON FORTRAN LOGICAL UNIT 
FUNIT TC READ. 

3 OPEN FILE FNAME ON FORTRAN LOGICAL UNIT 
FUNIT TO WPITE. 

“4 ' CLOSE FILE FNAME. ' ' * 

5 DELETE FILE FNAME FROM CURRENT UFO. 

6 CHANGE NAME OF FILE FNAME TC CNAME. ' 
HOLLERITH FILE NAME. UP TO 6 CHARACTERS. 
INTEGER FNAME(2) 

FORTRAN LCC-ICAL UNIT. 

INTEGER FUNIT . - . - 

NEW FILE NAME FOR ENTRJT 6. _ 

INTEGER CNAME(2) ‘ ' ~ ' . ‘ 

ERROR CODE. 

CODES 0 IF OPERATION SUCCESSFUL. 

NONZERO OTHERWISE. 

INTEGER CODE - - . 


SYSTEM SUPPLIED PARAMETERS 

SYSCOM>KEVS.F MNEMONIC KEYS FOP FILE SYSTEM (FTN) 31 MAY. 1* 

NOLIST 


LOCAL DECLARATIONS 

INTEGEF*2 INAME. MODE. PUNIT. SPAR. 

.* NTEXT 

INTEGER TEXT (2.6) 

DATA TEXT / 4HFIND.4H . 4H0PEN.4H • 

* 4H0PEN.4H . 4HCLOS.4HE ♦ 

* 4HDELE.4HTF . 4HP.ENA.4HME /. 

* NTEXT / 8 / _ _ _ 

DATA INAME / 6 / 


CODES 0 

IF (NTRY. EG. 6) 
SPARS KIEXST 
IF (NTRY. EG. 2) 
IF (NTRY.E0.3) 
IF (NTRY. EC. 4) 
IF (NTRY. EC. 5) 


GO 

TO 

500 ■ 

SP 

AR = 

KSPEAO 

SP 

ARs 

KtURIT 

•SP 

ARs 

KICLOS 

SPARr 

KIDELE 


PUNIT= FUNIT- 4 

IF ( (NTRY.EG.l ).OR. (NTPY'.E0.5 > )'PUNITs~(j' 
ITYPEs n 


CALL SPCFJt! SPAR. FNAME. INAME. PUNIT. ITYPE. KODF ) 
COOES KCDE 


IF (NTRY. EC. 1) RETURN ' ' 

IF ( (NTRY.EQ.5) .AND. (CODE. EC. 15) ) RETURN 

CALL ERRPRM KSIRTN, MODE. TEXT < 1 .NTRY) . NTEXTi FNAME. INAME) 





“"SUBROUTINE FILES! NTRY» FNAME* FUNIT t CNAMEt' CODE 


I 

1 

I 


(0366) RETURN • 

<0367) C _ 

C0368) bOO CALL CNARSSi FNAME« INANE t 'CNAHE • INANE«~KdDE > 

(0369) CODE: RODE 

<0370) CALL ERPPRS< KAIRTN* KODEt TEXT <1«NTRY) « NTEXTt FNANEt INANE) 

<0371) RETURN . _ __ 

<0372) C - - — — 

<0373) ENO 

PROGRAN size: PROCEOLRe - 000266 LINKAGE - 000071 STACK • 000036 

0000 ERRORS CCFlLES >FTN-REV15.3] _ __ 




SUOROUTINC MSO I NCH« HCSSGC ) 


SUBRCUTINC RS6 ( NCHt HESSGC > 
CISPIAYS HCSSAGE ON CRT^ 


(0374) 

(037S) C 
(0376) C 
(0377) C 
(0378) C 
(0379) C 
(0380) C 
(0381) 

(0382) C 
^0383) C 
(0384) 

(0385) 

(0386) C 
(0387) C 
(0388) 

(0389) 

(0390) 

(0391) 

(0392) C 
(0393) 

(0394) END 

PROGRAM size: PROCEPURF - 000101 

0000 ERRORS C <MSG >FTN-RrV15.33 


NCH (INPUT) 

MESSGE (INPUT) 

NUMBER OF CHARACTERS IN MESSAGE. 
MESSAGE TO DISPLAY. 

DIMENSION MESSGE(NCH) 

• • 

LOCAL PECLAPATIONS 

INTEGER CRT " ■" 

DATA CP.T/1/t NCU/4/ 

• - 




NN= NCH/NCU 
IF (NN*NCW .LT, 
WRITE (CRTflOO) 
100 FORMAT ( 20A4 ) 

NCH) NN=NN*1 
(MESSGE(1N).IN=1»NN) 



RETURN 




LINKAGE - 000037 


STACK - 000022 






I 


SUBROUTINE SETHOL I 'ARR AV* ‘ NCH, HOLCON ) 


(0395) 

(0396) 

(0397) 

(0396) 

(0399) 

(0400) 

(0401) 

(0402) 

(0403) 

(0404) 

(0405) 

(0406) 

(0407) 

(0406) 

(0409) 

(0410) 

(0411) 

(0412) 

(0413) 

(0414) 

(0415) 

(0416) 

(0417) 

(0418) 

(0419) 

(0420) 

(0421) 

PROGRAM 


SUBROUTINE SETHOL I ARRAY* NCH* HOLCON ) 


PUTS HOLLERITH CONSTANT 
USED TO AVOIC THE CRUDE 
DATA STATEMENT. 


INTO ARRAY. 
RESTRICTIONS 


OF THE ANSI 


ARGUMENT LIST 


ARRAY 

NCH 

HOLCON 


(INPUT) HOLLERITH STRING WILL 3E 
INTEGER ARRAY (NCH) 
(INPUT) NUMBER OF CHARACTERS IN 

(INPUT) HOLLERITH STRING TO STOR 

INTEGER HCLCCN (NCH) 


STORED IN ARRAY. 

HOLLERITH STRING. 

E. 


LOCAL DECLARATIONS 
DATA NCV/4/ 


100 


size: 


NN= NCH/NCW „ „ _ 

IF ( NN*NCW .LT. NCH ) NN= NN4l" 
DO 100 IN=1*NN 
ARRAY(IN)= HOLCON(IN) 

CONTINUE 


RETURN 

END 

PROCEDURE - 


000057 


LINKAGE 


000026 


STACK - C00024 


0000 ERRORS C< SETHOOF TN-R EVl D .3 3 




